*DECK XF31                                                              00000100
      PROGRAM MAIN(INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT,               00000101
     1TAPE2,TAPE3,TAPE4,TAPE8,TAPE9,TAPE10,TAPE11,TAPE12,               00000102
     2PUNCH,FILMPL=0,SCOUTV=64,TAPE16=SCOUTV)                           00000103
C                                                                       00000104
C     TPS MULTIDIMENSIONAL HEAT CONDUCTION PROGRAM - CDC0031            00000105
C     L.W. FESLER     41-383/530  X4263                                 00000200
C                                                                       00000300
C                *****      *****      *****      *****                 00000400
C                                                                       00000500
C     THIS PROGRAM COMPUTES THE TRANSIENT TEMPERATURE HISTORY FOR       00000600
C     COMPLEX BODY GEOMETRIES IN MULTI-DIMENSIONS FOR PROBLEMS          00000700
C     CONCERNED WITH THE THERMAL PROTECTION SYSTEM OF SPACE RESUPPLY    00000800
C     VEHICLES.  THE INPUT TO THE PROGRAM CONSISTS OF THE GEOMETRY OF   00000900
C     PHYSICAL SYSTEM, THE MATERIAL PROPERTIES, AND THE BOUNDARY        00001000
C     CONDITIONS.  OUTPUT IS IN THE FORM OF A TEMPERATURE VERSUS TIME   00001100
C     HISTORY FOR EACH NODE.  THE PROGRAM INCLUDES AN OPTION FOR        00001200
C     SOLUTION OF STEADY STATE PROBLEMS.                                00001300
C                                                                       00001400
C                *****      *****      *****      *****                 00001500
C                                                                       00001600
C     PROGRAM OUTLINE --                                                00001700
C       MAIN PROGRAM XF31                                               00001800
C       SUBROUTINE DOMT                                                 00001900
C       FUNCTION LONP                                                   00002000
C       FUNCTION LOAP                                                   00002100
C       FUNCTION MSTD                                                   00002200
C       FUNCTION MPTD                                                   00002300
C       FUNCTION ICRD                                                   00002400
C       FUNCTION TBLP                                                   00002500
C       FUNCTION HAIR                                                   00002600
C       FUNCTION SYMB                                                   00002700
C       FUNCTION FNSP                                                   00002800
C       FUNCTION IPDA                                                   00002900
C       SUBROUTINE COND                                                 00003000
C       SUBROUTINE CODD                                                 00003100
C       SUBROUTINE INPT                                                 00003200
C       SUBROUTINE MODS                                                 00003300
C       SUBROUTINE BDRY                                                 00003400
C       SUBROUTINE INPS                                                 00003500
C       SUBROUTINE TBLS                                                 00003600
C       SUBROUTINE COPT                                                 00003700
C       SUBROUTINE CDTA                                                 00003800
C       SUBROUTINE RIFA                                                 00003900
C       SUBROUTINE TLOP                                                 00004000
C       SUBROUTINE WRITE                                                00004100
C       SUBROUTINE TLPP                                                 00004200
C       SUBROUTINE CAPD                                                 00004300
C       SUBROUTINE NETQ                                                 00004400
C       SUBROUTINE IMPT                                                 00004500
C       SUBROUTINE EXPT                                                 00004600
C       SUBROUTINE SDST                                                 00004700
C       SUBROUTINE OTPT                                                 00004800
C       SUBROUTINE PNCH                                                 00004900
C       SUBROUTINE TIMEV                                                00004901
C       FUNCTION ISIMEQ                                                 00004902
C                                                                       00005000
C                *****      *****      *****      *****                 00005100
C                                                                       00005200
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00005300
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00005400
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00005500
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00005600
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00005700
     5              ICLOCK,IDOMT,INPP(33)                               00005701
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00005800
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00005900
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00006000
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300),       00006100
     4              ICRDR,ICRDP,CORD(3,300)                             00006200
      COMMON /CMN3/ TBSTG(4000),TBID(14,99)                             00006300
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00006400
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00006500
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00006600
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00006700
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00006800
     2              DGP2(75),PGSF(75),BQGP(75),                         00006900
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00007000
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00007100
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00007200
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00007300
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00007400
     3              FP(75,3,2),BQA(75,3,2),                             00007500
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00007600
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00007700
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00007800
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00007900
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00008000
      COMMON /CMN7/ NRIO(3,2),NRI(25,3,2),ERI(25,3,2),DRI(25,3,2),      00008100
     1              ZRI(25,3,2),NAVT(2),BVT(40,40,2),NBVT(40,2),        00008200
     2              NVFO(2),NVFI(750,2),NVFJ(750,2),VFIJ(750,2),SFAS(2) 00008300
      COMMON /CMN9/ NCRTO(5),NCRT(11,50,5),NCSEO,NCSE(300),NCSSO,       00008400
     1              NCSS(99),NCPT(99),NHLDO,NHLD(300),NHRTO,NHRT(300),  00008500
     2              TENRY,TDOWN,YSCLE(2,5),IPCRT                        00008600
      COMMON /CMNS/ NSIZE,STEMP(10),SDRAT(10),STIME(10),ISIZE,TSZO,     00008700
     1              SIZET,DEGSZ,NODSZ,METSZ,IDRSZ,IPNSZ,ITRSZ,RDMIN     00008800
      COMMON /CMNY/ TT1,TT2,TT3,TT4,TT5,TT6,TT7                         00008900
      COMMON /CDCD/ IRAND(7000)                                         00008901
      COMMON /CMNP/ AAA(12)                                             00008902
      DIMENSION CM11(35),CM12(624),CM21(4299),CM22(1502),CM3(5386),     00009000
     1          CM4(602),CM5(1328),CM6(9088),CM7(8392),                 00009100
     2          CM91(2755),CM92(12)                                     00009200
      EQUIVALENCE (CM11(1),INPO(1)),(CM12(1),DELT),(CM21(1),NSCTL(1)),  00009300
     1            (CM22(1),PCQL(1)),(CM3(1),TBSTG(1)),(CM4(1),NMTLO),   00009400
     2            (CM5(1),NGAPO),(CM6(1),NAO(1,1)),(CM7(1),NRIO(1,1)),  00009500
     3            (CM91(1),NCRTO(1)),(CM92(1),TENRY)                    00009600
      DATA CLOCK / "TIME" /                                             00009700
C                                                                       00009800
 0100 FORMAT(1H15X,"EXECUTION TIMES"/1H 5X,"NCASE",I4///                00009900
     11H 5X,"START EXECUTION",6X,F8.3,"  MINUTES"/                      00010000
     21H 5X,"END INPUT DATA",7X,F8.3,"  MINUTES"/                       00010100
     31H 5X,"END COMPUTED DATA",4X,F8.3,"  MINUTES"/                    00010200
     41H 5X,"END TIME LOOP",8X,F8.3,"  MINUTES"/                        00010300
     51H 5X,"END OUTPUT DATA",6X,F8.3,"  MINUTES")                      00010400
  110 FORMAT(1H //////1H 5X,"TIME LOOP BREAKDOWN  "/                    00010500
     11H 5X,"CAPACITANCE          ",F8.3,"  MINUTES"/                   00010600
     21H 5X,"CONDUCTANCE          ",F8.3,"  MINUTES"/                   00010700
     31H 5X,"NET HEAT             ",F8.3,"  MINUTES"/                   00010800
     41H 5X,"SOLVE SYSTEM         ",F8.3,"  MINUTES"/                   00010900
     51H 5X,"DMTX TESTS           ",F8.3,"  MINUTES"/                   00011000
     61H 5X,"I/O                  ",F8.3,"  MINUTES"/                   00011100
     71H 5X,"OTHER                ",F8.3,"  MINUTES")                   00011200
  115 FORMAT(1H //////1H 5X,"TABLE LOOKUP TIME    ",F8.3,"  MINUTES")   00011300
  120 FORMAT(1H15X,"SIZING PASS SUMMARY"/1H 5X,"NCASE",I4///            00011400
     11H 5X,"NSIZE=",I5//1H 5X,"NPASS",8X,"TEMP",7X,"RATIO",8X,"TIME"/  00011500
     2(1H 5X,I5,3F12.3))                                                00011600
  130 FORMAT(1H //////1H 5X,"NPASS=",I4//1H 5X,"NSCT",8X,"DX",8X,       00011700
     1"DY",8X,"DZ")                                                     00011800
  131 FORMAT(1H 5X,I4,F10.3)                                            00011900
  132 FORMAT(1H 5X,I4,10X,F10.3)                                        00012000
  133 FORMAT(1H 5X,I4,20X,F10.3)                                        00012100
C                                                                       00012200
C     INITIALIZE                                                        00012300
 1000 NCASE=0                                                           00012500
      IDOMT=0                                                           00012600
      IPCRT=0                                                           00012601
      CALL OPENMS(12,IRAND,7000,0)                                      00012602
C                                                                       00012700
C     CASE LOOP                                                         00012800
 1100 CALL TIMEV(TIME1)                                                 00012900
      REWIND 2                                                          00013000
      REWIND 3                                                          00013100
      REWIND 4                                                          00013200
      REWIND 8                                                          00013300
      REWIND 9                                                          00013400
      REWIND 10                                                         00013500
      TT1=0.0                                                           00013600
      TT2=0.0                                                           00013700
      TT3=0.0                                                           00013800
      TT4=0.0                                                           00013900
      TT5=0.0                                                           00014000
      TT6=0.0                                                           00014100
      TT7=0.0                                                           00014200
      NSIZE=0                                                           00014300
      ISIZE=0                                                           00014400
      IPNSZ=0                                                           00014500
      TMS5=0.0                                                          00014600
      ICLOCK=0                                                          00014700
C                                                                       00014800
C     INPUT DATA                                                        00014900
 1200 CALL INPT                                                         00015000
      CALL BDRY                                                         00015100
      CALL INPS                                                         00015200
      CALL TBLS                                                         00015300
      IF (NCASE.NE.1) GO TO 1210                                        00015400
      IF (INPO(36).NE.2) GO TO 1210                                     00015500
      REWIND 11                                                         00015600
      WRITE (11) CM11,CM12,ICLOCK,CM21,CM22,CM3,CM4,CM5,CM6,            00015700
     1           CM7,CM91,CM92                                          00015800
 1210 CALL TIMEV(TIME2)                                                 00015900
      TIME4=TIME2                                                       00016000
      TMS3=TIME2                                                        00016100
      IF (TITLE(14).EQ.CLOCK) ICLOCK=1                                  00016200
C                                                                       00016300
C     SIZING OPTION                                                     00016400
 1250 IF (ISIZE.EQ.0) GO TO 1300                                        00016500
      IF (NSIZE.EQ.0) GO TO 1260                                        00016600
      WRITE (6,120) NCASE,NSIZE,(I,STEMP(I),SDRAT(I),STIME(I),          00016700
     1I=1,NSIZE)                                                        00016800
      WRITE (6,130) NSIZE                                               00016900
      DO 1252 I=1,NSCTO                                                 00017000
      IF (MTLN(I).NE.METSZ) GO TO 1252                                  00017100
      IF (IDRSZ.EQ.1) WRITE (6,131) NSCT(I),DX(I)                       00017200
      IF (IDRSZ.EQ.2) WRITE (6,132) NSCT(I),DY(I)                       00017300
      IF (IDRSZ.EQ.3) WRITE (6,133) NSCT(I),DZ(I)                       00017400
 1252 CONTINUE                                                          00017500
      IF (ABS(STEMP(NSIZE)-SIZET).LT.DEGSZ) GO TO 1255                  00017600
      IF (NSIZE.GE.ITRSZ) GO TO 1255                                    00017700
      IF (NSIZE.LT.10) GO TO 1260                                       00017800
 1255 ISIZE=-1                                                          00017900
      GO TO 1500                                                        00018000
 1260 NSIZE=NSIZE+1                                                     00018100
      STEMP(NSIZE)=0.0                                                  00018200
      STIME(NSIZE)=0.0                                                  00018300
      IF (NSIZE.EQ.1) GO TO 1300                                        00018400
      IF (NSIZE.GT.2) GO TO 1265                                        00018500
      SDRAT(2)=(STEMP(1)-TSZO)/(SIZET-TSZO)                             00018600
      IF (SDRAT(2).LT.RDMIN) SDRAT(2)=RDMIN                             00018700
      GO TO 1275                                                        00018800
 1265 IF (NSIZE.GT.3) GO TO 1270                                        00018900
      SDRAT(3)=SDRAT(1)+((SIZET-STEMP(1))/(STEMP(2)-STEMP(1)))*         00019000
     1(SDRAT(2)-SDRAT(1))                                               00019100
      IF (SDRAT(3).GT.RDMIN) GO TO 1275                                 00019200
      IF (SDRAT(2).EQ.RDMIN) GO TO 1255                                 00019300
      SDRAT(3)=RDMIN                                                    00019400
      GO TO 1275                                                        00019500
 1270 NSZ=NSIZE-3                                                       00019600
      SDRAT(NSIZE)=FNSP(1,2,3,SIZET,STEMP(NSZ),SDRAT(NSZ))              00019700
 1275 IF (SDRAT(NSIZE).LT.RDMIN) GO TO 1255                             00019800
      RAT=SDRAT(NSIZE)/SDRAT(NSIZE-1)                                   00019900
      DO 1280 I=1,NSCTO                                                 00020000
      IF (MTLN(I).NE.METSZ) GO TO 1280                                  00020100
      IF (IDRSZ.EQ.1) DX(I)=DX(I)*RAT                                   00020200
      IF (IDRSZ.EQ.2) DY(I)=DY(I)*RAT                                   00020300
      IF (IDRSZ.EQ.3) DZ(I)=DZ(I)*RAT                                   00020400
 1280 CONTINUE                                                          00020500
C                                                                       00020600
C     CONSTANT DATA                                                     00020700
 1300 CALL CDTA                                                         00020800
      IF (DELT.EQ.0.0.AND.RCMIN.EQ.0.0) GO TO 1305                      00020801
      IF (TEND.LE.TIMEO) GO TO 1310                                     00020900
 1305 IF (NRIOO.NE.0) CALL RIFA                                         00021000
 1310 CALL TIMEV(TIME3)                                                 00021100
      TMS3=TMS3+(TIME3-TIME4)                                           00021200
      IF (NSIZE.LE.1) TMS4=TMS3                                         00021300
C                                                                       00021400
C     TIME LOOP                                                         00021500
 1400 IF (RCMIN.GT.0.0) GO TO 1410                                      00021600
      IF (DELT.NE.0.0) GO TO 1410                                       00021700
      CALL SDST                                                         00021800
      GO TO 1420                                                        00021900
 1410 CALL TLOP                                                         00022000
 1420 CALL TIMEV(TIME4)                                                 00022100
      TMS4=TMS4+(TIME4-TIME3)                                           00022200
      IF (ISIZE.LE.0) GO TO 1500                                        00022300
      IF (TEND.LE.TIMEO) GO TO 1500                                     00022400
      IF (IPNSZ.LT.2) GO TO 1250                                        00022500
C                                                                       00022600
C     OUTPUT DATA                                                       00022700
 1500 IF (RCMIN.GT.0.0) GO TO 1510                                      00022800
      IF (DELT.EQ.0.0) GO TO 1520                                       00022900
 1510 IF (TEND.LE.TIMEO) GO TO 1520                                     00023000
      IF (INPO(35).LT.-104) GO TO 1515                                  00023001
      IPNT=IABS(INPO(35))                                               00023100
      IF (IPNT.GT.99) IPNT=IPNT-100                                     00023200
      IF (INPO(35).LT.0) CALL PNCH                                      00023300
      IF (IPNT.EQ.1) GO TO 1520                                         00023400
 1515 CALL OTPT                                                         00023500
 1520 CALL TIMEV(TIME5)                                                 00023600
      TMS5=TMS5+(TIME5-TIME4)                                           00023700
      IF (TEND.LE.TIMEO) GO TO 1600                                     00023800
      IF (ISIZE.GT.0) GO TO 1250                                        00023900
      IF (ISIZE.EQ.0) GO TO 1600                                        00024000
      WRITE (6,120) NCASE,NSIZE,(I,STEMP(I),SDRAT(I),STIME(I),          00024100
     1I=1,NSIZE)                                                        00024200
C                                                                       00024300
C     EXECUTION TIME                                                    00024400
 1600 TME0=0.0                                                          00024500
      TME1=(TIME2-TIME1)/60.0                                           00024600
      TIME3=TMS3                                                        00024700
      TIME4=TMS4                                                        00024800
      TIME5=TMS5+TIME4                                                  00024900
      TME2=(TIME3-TIME1)/60.0                                           00025000
      TME3=(TIME4-TIME1)/60.0                                           00025100
      TME4=(TIME5-TIME1)/60.0                                           00025200
      WRITE (6,100) NCASE,TME0,TME1,TME2,TME3,TME4                      00025300
      IF (ICLOCK.EQ.0) GO TO 1900                                       00025400
      TT1=TT1/60.0                                                      00025500
      TT2=TT2/60.0                                                      00025600
      TT3=TT3/60.0                                                      00025700
      TT4=TT4/60.0                                                      00025800
      TT5=TT5/60.0                                                      00025900
      TT6=TT6/60.0                                                      00026000
      TT8=(TME3-TME2)-(TT1+TT2+TT3+TT4+TT5+TT6)                         00026100
      WRITE (6,110) TT1,TT2,TT3,TT4,TT5,TT6,TT8                         00026200
      TT7=TT7/60.0                                                      00026300
      WRITE (6,115) TT7                                                 00026400
C                                                                       00026500
C     TO NEXT CASE                                                      00026600
 1900 GO TO 1100                                                        00026700
      END                                                               00026800
*DECK DOMT                                                              00026801
C     SUBROUTINE DOMT OF PROGRAM XF0031                                 00026900
C     L.W. FESLER     41-383/530  X4263                                 00027000
C                                                                       00027100
      SUBROUTINE DOMT                                                   00027200
C                                                                       00046500
  200 FORMAT(1H15X,"PROGRAM XF0031     TPS MULTIDIMENSIONAL HEAT ",     00046600
     1"CONDUCTION     DOCUMENT SD75-SH-0139A DATED 4-79"/               00046700
     21H 5X,"CONTACT   L.W. FESLER 383/530 X4263   FOR INFORMATION ",   00046800
     3"ON USE OF PROGRAM"///1H 5X,"THE FOLLOWING OPTIONS HAVE BEEN ",   00046900
     4"ADDED TO THE PROGRAM AFTER DOCUMENT SD75-SH-0139A WAS PUBLISHED"/00047000
     51H 5X,"AND WILL BE INCLUDED IN THE PROGRAM DOCUMENTATION WHEN ",  00047100
     6"A NEW DOCUMENT IS ISSUED.")                                      00047200
  290 FORMAT(1H //1H 5X,"*** TO BE ADDED")                              00047300
C                                                                       00053800
 1000 WRITE (6,200)                                                     00053900
      WRITE (6,290)                                                     00054000
C                                                                       00054700
 9000 RETURN                                                            00054800
      END                                                               00054900
*DECK LONP                                                              00054901
C     FUNCTION LONP OF PROGRAM XF0031                                   00055000
C     L.W. FESLER     41-383/530  X4263                                 00055100
C                                                                       00055200
C                *****      *****      *****      *****                 00055300
C                                                                       00055400
C     THIS FUNCTION LOCATES A NUMBER FROM AN ARRAY OF ARBITRARY         00055500
C     NUMBERS.                                                          00055600
C                                                                       00055700
C                *****      *****      *****      *****                 00055800
C                                                                       00055900
C     LIST OF ARGUMENTS --                                              00056000
C       N  - NUMBER                                                     00056100
C       NE - NUMBER OF ENTRIES                                          00056200
C       IA - ARRAY OF NUMBERS                                           00056300
C                                                                       00056400
C                *****      *****      *****      *****                 00056500
C                                                                       00056600
      FUNCTION LONP(N,NE,IA)                                            00056700
C                                                                       00056800
      DIMENSION IA(1)                                                   00056900
C                                                                       00057000
 1000 LONP=0                                                            00057100
      IF (NE.LE.0) GO TO 1090                                           00057200
      NBR=IABS(N)                                                       00057300
      DO 1010 I=1,NE                                                    00057400
      IF (NBR.NE.IA(I)) GO TO 1010                                      00057500
      LONP=I                                                            00057600
      GO TO 1090                                                        00057700
 1010 CONTINUE                                                          00057800
 1090 RETURN                                                            00057900
      END                                                               00058000
*DECK LOAP                                                              00058001
C     FUNCTION LOAP OF PROGRAM XF0031                                   00058100
C     L.W. FESLER     41-383/530  X4263                                 00058200
C                                                                       00058300
C                *****      *****      *****      *****                 00058400
C                                                                       00058500
C     THIS FUNCTION LOCATES A NUMBER PAIR (NI,NJ) FROM TWO ARRAYS       00058600
C     (IAI,IAJ) OF ARBITRARY NUMBERS.                                   00058700
C                                                                       00058800
C                *****      *****      *****      *****                 00058900
C                                                                       00059000
C     LIST OF ARGUMENTS --                                              00059100
C       NI  - NUMBER                                                    00059200
C       NJ  - NUMBER                                                    00059300
C       NE  - NUMBER OF ENTRIES                                         00059400
C       IAI - ARRAY OF NUMBERS                                          00059500
C       IAJ - ARRAY OF NUMBERS                                          00059600
C                                                                       00059700
C                *****      *****      *****      *****                 00059800
C                                                                       00059900
      FUNCTION LOAP(NI,NJ,NE,IAI,IAJ)                                   00060000
C                                                                       00060100
      DIMENSION IAI(1),IAJ(1)                                           00060200
C                                                                       00060300
 1000 LOAP=0                                                            00060400
      IF (NE.LE.0) GO TO 1090                                           00060500
      NBI=IABS(NI)                                                      00060600
      NBJ=IABS(NJ)                                                      00060700
      DO 1010 I=1,NE                                                    00060800
      IF (NBI.NE.IAI(I)) GO TO 1010                                     00060900
      IF (NBJ.NE.IAJ(I)) GO TO 1010                                     00061000
      LOAP=I                                                            00061100
      GO TO 1090                                                        00061200
 1010 CONTINUE                                                          00061300
 1090 RETURN                                                            00061400
      END                                                               00061500
*DECK MSTD                                                              00061501
C     FUNCTION MSTD OF PROGRAM XF0031                                   00061600
C     L.W. FESLER     41-383/530  X4263                                 00061700
C                                                                       00061800
C                *****      *****      *****      *****                 00061900
C                                                                       00062000
C     THIS FUNCTION STORES THE SPECIFIED ARGUMENT IN THE SPECIFIED      00062100
C     STORAGE FOR IB=1, OR STORES THE SPECIFIED ARGUMENT IN THE         00062200
C     SPECIFIED STORAGE IF THE ARGUMENT IS NOT BLANK FOR IB=2.  BLANK   00062300
C     IS DEFINED TO BE -0 FOR INTEGER NUMBERS AND -0.0 FOR REAL         00062400
C     NUMBERS.                                                          00062500
C                                                                       00062600
C                *****      *****      *****      *****                 00062700
C                                                                       00062800
C     LIST OF ARGUMENTS --                                              00062900
C       IB  - TEST OPTION         1 - ALWAYS STORE                      00063000
C                                 2 - STORE IF NOT BLANK                00063100
C       IS  - STORAGE OPTION      1 - USE ISG                           00063200
C                                 2 - USE ASG                           00063300
C       IT  - ARGUMENT OPTION     1 - USE IRG                           00063400
C                                 2 - USE ARG                           00063500
C       ISG - INTEGER STORAGE                                           00063600
C       IRG - INTEGER ARGUMENT                                          00063700
C       ASG - REAL STORAGE                                              00063800
C       ARG - REAL ARGUMENT                                             00063900
C                                                                       00064000
C                *****      *****      *****      *****                 00064100
C                                                                       00064200
      FUNCTION MSTD(IB,IS,IT,ISG,IRG,ASG,ARG)                           00064300
C                                                                       00064400
      EQUIVALENCE (IARG,AARG)                                           00064500
C                                                                       00064600
      DATA IBLK / 77777777777777777777B /                               00064700
      DATA MASK / 77770000000000000000B /                               00064701
C                                                                       00064800
 1000 MSTD=0                                                            00064900
      AARG=ARG                                                          00065000
      IIRG=IRG.AND.MASK                                                 00065001
      IIARG=IARG.AND.MASK                                               00065002
      IF (IB.EQ.1) GO TO 1020                                           00065100
      IF (IT.EQ.2) GO TO 1010                                           00065200
      IF (IRG.EQ.IBLK.AND.IIRG.NE.0) GO TO 1090                         00065300
      GO TO 1020                                                        00065400
 1010 IF (IARG.EQ.IBLK.AND.IIARG.NE.0) GO TO 1090                       00065500
 1020 MSTD=1                                                            00065600
      IF (IS.EQ.2) GO TO 1040                                           00065700
 1030 ISG=IRG                                                           00065800
      IF (IT.EQ.1) GO TO 1090                                           00065900
      ISG=ARG                                                           00066000
      IF (IARG.EQ.IBLK.AND.IIARG.NE.0) ISG=IBLK                         00066100
      GO TO 1090                                                        00066200
 1040 ASG=ARG                                                           00066300
 1090 RETURN                                                            00066400
      END                                                               00066500
*DECK MPTD                                                              00066501
C     FUNCTION MPTD OF PROGRAM XF0031                                   00066600
C     L.W. FESLER     41-383/530  X4263                                 00066700
C                                                                       00066800
C                *****      *****      *****      *****                 00066900
C                                                                       00067000
C     THIS FUNCTION PRINTS THE SPECIFIED ARGUMENT USING THE SPECIFIED   00067100
C     FORMAT IF THE VALUE OF THE ARGUMENT IS NOT BLANK.  BLANK IS       00067200
C     DEFINED TO BE -0 FOR INTEGER NUMBERS AND -0.0 FOR REAL NUMBERS.   00067300
C     FOR ALPHANUMERICS, XN=10000+N, YN=20000+N, ZN=30000+N.            00067400
C                                                                       00067500
C                *****      *****      *****      *****                 00067600
C                                                                       00067700
C     LIST OF ARGUMENTS --                                              00067800
C       IT  - ARGUMENT OPTION     1 - USE IRG                           00067900
C                                 2 - USE ARG                           00068000
C       IS  - PRINT COLUMN                                              00068100
C       IW  - FIELD WIDTH                                               00068200
C       ID  - DECIMAL PLACES      0 - PRINT AS INTEGER                  00068300
C                                 N - PRINT AS REAL                     00068400
C                                -N - PRINT AS ALPHANUMERIC             00068500
C       IRG - INTEGER ARGUMENT                                          00068600
C       ARG - REAL ARGUMENT                                             00068700
C                                                                       00068800
C                *****      *****      *****      *****                 00068900
C                                                                       00069000
      FUNCTION MPTD(IT,IS,IW,ID,IRG,ARG)                                00069100
C                                                                       00069200
      COMMON /CMNP/ AAA(12)                                             00069201
      DIMENSION FMT(7)                                                  00069300
      DIMENSION BBB(12)                                                 00069301
      EQUIVALENCE (FIS,IIS),(FIW,IIW),(FID,IID),(FII,III)               00069400
      EQUIVALENCE (IARG,AARG)                                           00069500
C                                                                       00069600
      DATA FMT / 10H(12A10,T2,,1H ,4HX, I,1H ,1H ,1H ,1H) /             00069700
      DATA INBR,IBLK / 33333333333333333333B,77777777777777777777B /    00069800
      DATA MASK / 77770000000000000000B /                               00069801
      DATA FMTI,FMTF,FMTA / 4HX, I,4HX, F,4HX, A /                      00069900
      DATA FMTP,FMTC,FMTB / 1H.,4H1, I,1H  /                            00070000
      DATA FX,FY,FZ / 1HX,1HY,1HZ /                                     00070100
C                                                                       00070200
 1000 MPTD=0                                                            00070300
      DO 1005 I=1,12                                                    00070301
 1005 BBB(I)=AAA(I)                                                     00070302
      AARG=ARG                                                          00070400
      IIRG=IRG.AND.MASK                                                 00070401
      IIARG=IARG.AND.MASK                                               00070402
      IF (IT.EQ.2) GO TO 1010                                           00070500
      IF (IRG.EQ.IBLK.AND.IIRG.NE.0) GO TO 1090                         00070600
      GO TO 1020                                                        00070700
 1010 IF (IARG.EQ.IBLK.AND.IIARG.NE.0) GO TO 1090                       00070800
 1020 MPTD=1                                                            00070900
      IIS=INBR+64*(IS/10)+IS-10*(IS/10)                                 00071000
      FMT(2)=FIS                                                        00071100
      IF (ID.LT.0) GO TO 1050                                           00071200
      IIW=INBR+64*(IW/10)+IW-10*(IW/10)                                 00071300
      FMT(4)=FIW                                                        00071400
      IF (ID.GT.0) GO TO 1040                                           00071500
 1030 INR=IRG                                                           00071600
      IF (IT.EQ.2) INR=ARG                                              00071700
      FMT(3)=FMTI                                                       00071800
      FMT(5)=FMTB                                                       00071900
      FMT(6)=FMTB                                                       00072000
      ENCODE(120,FMT,AAA) BBB,INR                                       00072100
      GO TO 1090                                                        00072200
 1040 IID=INBR+64*(ID/10)+ID-10*(ID/10)                                 00072300
      FMT(3)=FMTF                                                       00072400
      FMT(5)=FMTP                                                       00072500
      FMT(6)=FID                                                        00072600
      ENCODE(120,FMT,AAA) BBB,ARG                                       00072700
      GO TO 1090                                                        00072800
 1050 NBR=IRG-10000*(IRG/10000)                                         00072900
      IF (NBR.EQ.0) GO TO 1090                                          00073000
      II=1                                                              00073100
      IF (NBR.GE.10) II=2                                               00073200
      IF (NBR.GE.100) II=3                                              00073300
      III=INBR+II                                                       00073400
      FMT(3)=FMTA                                                       00073500
      FMT(4)=FMTC                                                       00073600
      FMT(5)=FII                                                        00073700
      FMT(6)=FMTB                                                       00073800
      AA=FX                                                             00073900
      IF (IRG.GT.20000) AA=FY                                           00074000
      IF (IRG.GT.30000) AA=FZ                                           00074100
      ENCODE(120,FMT,AAA) BBB,AA,NBR                                    00074200
 1090 RETURN                                                            00074300
      END                                                               00074400
*DECK ICRD                                                              00074401
C     FUNCTION ICRD OF PROGRAM XF0031                                   00074500
C     L.W. FESLER     41-383/530  X4263                                 00074600
C                                                                       00074700
C                *****      *****      *****      *****                 00074800
C                                                                       00074900
C     THIS FUNCTION READS A CARD IN ALPHANUMERIC FORMAT AND             00075000
C     CONVERTS THE DATA TO THE SPECIFIED FORMAT.                        00075100
C                                                                       00075200
C                *****      *****      *****      *****                 00075300
C                                                                       00075400
C     LIST OF ARGUMENTS --                                              00075500
C       IW  - NUMBER OF REAL WORDS                                      00075600
C       IT  - TYPE OF CARD        0 - TITLE DATA                        00075700
C                                 1 - CONTROL DATA                      00075800
C                                 2 - SECTION DATA                      00075900
C                                 3 - MATERIAL DATA                     00076000
C                                 4 - GAP DATA                          00076100
C                                 5 - OFFSET DATA                       00076200
C                                 6 - CONTACT COEFFICIENT DATA          00076300
C                                 7 - HEAT FLUX DATA                    00076400
C                                 8 - RERADIATION DATA                  00076500
C                                 9 - RADIATION INTERCHANGE DATA        00076600
C                                10 - CONVECTION DATA                   00076700
C                                11 - KNOWN TEMPERATURE DATA            00076800
C                                12 - PHASE CHANGE DATA                 00076900
C                                13 - SPECIFIED CRT DATA                00077000
C                                14 - TABLE DATA TITLE                  00077100
C                                15 - TABLE DATA                        00077200
C       AR4 - DATA ARRAY                                                00077300
C                                                                       00077400
C                *****      *****      *****      *****                 00077500
C                                                                       00077600
      FUNCTION ICRD(IW,IT,AR4)                                          00077700
C                                                                       00077800
      DIMENSION AR4(20),ARY(20),AAS(6,5),AI(10),BCDN(7,15),FMT(6)       00077900
      REAL   AR8(12),END,EXEC,BLK8                                      00078000
      REAL   SEQ                                                        00078100
      EQUIVALENCE (FIW,IIW),(FIA,IIA)                                   00078200
C                                                                       00078300
      DATA END,EXEC,BLK8 / 3HEND,4HEXEC,1H  /                           00078400
      DATA BLK4,AAX,AAY,AAZ / 1H ,1HX,1HY,1HZ /                         00078500
      DATA AAP,AAM / 1H+,1H- /                                          00078600
      DATA AI / 1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H0 /               00078700
      DATA FMT / 1H(,1H ,4HF6.0,1H,,1H ,4HA4 ) /                        00078800
      DATA INBR,BLK / 33333333333333333333B,77777777777777777777B /     00078900
      DATA SFAT / "SFAM" /                                              00078901
      DATA BCDN / 4HCONT,4HROL ,4HDATA,4*1H ,                           00079000
     1            4HSECT,4HION ,4HDATA,4*1H ,                           00079100
     2            4HMATE,4HRIAL,4H DAT,4HA   ,3*1H ,                    00079200
     3            4HGAP ,4HDATA,5*1H ,                                  00079300
     4            4HOFFS,4HET D,4HATA ,4*1H ,                           00079400
     5            4HCONT,4HACT ,4HCOEF,4HFICI,4HENT ,4HDATA,1H ,        00079500
     6            4HHEAT,4H FLU,4HX DA,4HTA  ,3*1H ,                    00079600
     7            4HRERA,4HDIAT,4HION ,4HDATA,3*1H ,                    00079700
     8            4HRADI,4HATIO,4HN IN,4HTERC,4HHANG,4HE DA,4HTA  ,     00079800
     9            4HCONV,4HECTI,4HON D,4HATA ,3*1H ,                    00079900
     *            4HKNOW,4HN TE,4HMPER,4HATUR,4HE DA,4HTA  ,1H ,        00080000
     1            4HPHAS,4HE CH,4HANGE,4H DAT,4HA   ,2*1H ,             00080100
     2            4HSPEC,4HIFIE,4HD CR,4HT DA,4HTA  ,2*1H ,             00080200
     3            4HTABL,4HE DA,4HTA  ,4*1H ,                           00080300
     4            4HTABL,4HE DA,4HTA  ,4*1H /                           00080400
      DATA ICMT / "C   " /                                              00080500
C                                                                       00080600
  100 FORMAT(12A6,2X,A2,T1,A1,T73,A8)                                   00080700
  110 FORMAT(12A6,A8)                                                   00080800
  120 FORMAT(49X,A4,A3,6F1.0,5F2.0)                                     00080900
  130 FORMAT(6F6.0,30A1,F6.0)                                           00081000
  140 FORMAT(18X,F6.0)                                                  00081100
  145 FORMAT(18X,2F6.0)                                                 00081200
  150 FORMAT(66X,F6.0)                                                  00081300
  160 FORMAT(12X,F6.0)                                                  00081400
  170 FORMAT(1H 5X,12A6,A8)                                             00081500
  200 FORMAT(1H1//1H 5X,"END OF JOB - END OF CARDS"/                    00081600
     11H 5X,"ABNORMAL END - ",7A4)                                      00081700
C                                                                       00081800
 1000 ICRD=1                                                            00081900
      READ (5,100) AR8,AR4(20),FIW,SEQ                                  00082000
      IF (EOF(5)) 1080,1001                                             00082001
 1001 IF (IIW.NE.ICMT) GO TO 1002                                       00082100
      WRITE (6,170) AR8,SEQ                                             00082200
      GO TO 1000                                                        00082300
 1002 IF (AR8(1).EQ.END) ICRD=8                                         00082400
      IF (AR8(1).EQ.EXEC) ICRD=9                                        00082500
      IF (IT.EQ.13) GO TO 1005                                          00082600
      IF (AR8(1).EQ.BLK8) ICRD=-1                                       00082700
 1005 IF (ICRD.NE.1) GO TO 1090                                         00082800
      ENCODE(80,110,ARY) AR8,BLK8                                       00082900
      IF (IT.EQ.2) GO TO 1030                                           00083200
 1010 IIW=INBR+64*(IW/10)+IW-10*(IW/10)                                 00083300
      FMT(2)=FIW                                                        00083400
      IA=(72-6*IW)/4+1                                                  00083500
      IN=IW+IA                                                          00083600
      IIA=INBR+64*(IA/10)+IA-10*(IA/10)                                 00083700
      FMT(5)=FIA                                                        00083800
      DECODE(80,FMT,ARY) (AR4(I),I=1,IN)                                00083900
      DO 1020 I=1,IW                                                    00084000
      IF (AR8(I).EQ.BLK8) AR4(I)=BLK                                    00084100
 1020 CONTINUE                                                          00084200
      IF (IT.EQ.3) GO TO 1087                                           00084300
      IF (IT.EQ.9) GO TO 1088                                           00084400
      IF (IT.NE.14) GO TO 1090                                          00084500
      AR4(19)=0.0                                                       00084600
      IF (AR4(3).LT.-999.0) AR4(3)=1.0                                  00084601
      IF (AR4(3).EQ.-991.0) GO TO 1090                                  00084700
      IF (AR4(3).EQ.-995.0) GO TO 1025                                  00084800
      IF (AR4(3).EQ.-999.0) GO TO 1025                                  00084900
      IF (AR4(3).GE.0.0) GO TO 1090                                     00085000
      IF (AR4(3).EQ.-998.0) DECODE(80,140,ARY) AR4(19)                  00085200
      IF (AR4(3).GT.-990.0) DECODE(80,140,ARY) AR4(19)                  00085300
      IF (AR4(3).EQ.-994.0) DECODE(80,145,ARY) AR4(19),AR4(16)          00085400
      IF (AR4(3).LT.-993.0) GO TO 1025                                  00085500
      AR4(3)=-AR4(3)                                                    00085600
      GO TO 1090                                                        00085700
 1025 DECODE(80,120,ARY) AR4(17),AR4(18),(AR4(I),I=4,14)                00085800
      GO TO 1090                                                        00086000
 1030 IF (IW.EQ.1) GO TO 1010                                           00086100
      DECODE(80,130,ARY) (AR4(I),I=1,6),((AAS(J,K),J=1,6),K=1,5),AR4(12)00086200
      DO 1035 I=1,12                                                    00086300
      IF (AR8(I).EQ.BLK8) AR4(I)=BLK                                    00086400
 1035 CONTINUE                                                          00086500
      DO 1075 I=1,5                                                     00086600
      IS=6+I                                                            00086700
      NBR=0                                                             00086800
      IFG=0                                                             00086900
      JX=0                                                              00087000
      IF (AR8(IS).NE.BLK8) GO TO 1040                                   00087100
      AR4(IS)=BLK                                                       00087200
      GO TO 1075                                                        00087300
 1040 DO 1060 J=1,6                                                     00087400
      JS=7-J                                                            00087500
      TST=AAS(JS,I)                                                     00087600
      IF (TST.EQ.BLK4) GO TO 1060                                       00087700
      IF (IFG.EQ.1) GO TO 1050                                          00087800
      DO 1045 K=1,10                                                    00087900
      IF (TST.NE.AI(K)) GO TO 1045                                      00088000
      JX=JX+1                                                           00088100
      IF (K.NE.10) NBR=NBR+K*(10**(JX-1))                               00088200
      GO TO 1050                                                        00088300
 1045 CONTINUE                                                          00088400
      IFG=1                                                             00088500
 1050 IF (TST.EQ.AAX) NBR=10000+NBR                                     00088600
      IF (TST.EQ.AAY) NBR=20000+NBR                                     00088700
      IF (TST.EQ.AAZ) NBR=30000+NBR                                     00088800
      IF (TST.EQ.AAP) NBR=10000+NBR                                     00088900
      IF (TST.EQ.AAM) NBR=20000+NBR                                     00089000
      IF (NBR.GT.10000) GO TO 1070                                      00089100
 1060 CONTINUE                                                          00089200
      IF (NBR.EQ.0) GO TO 1070                                          00089300
      IF (NBR.LT.10000) NBR=10000+NBR                                   00089400
 1070 AR4(IS)=NBR                                                       00089500
 1075 CONTINUE                                                          00089600
      GO TO 1090                                                        00089700
 1080 IF (IT.EQ.0) GO TO 1085                                           00089800
      WRITE (6,200) (BCDN(I,IT),I=1,7)                                  00089900
 1085 STOP                                                              00090000
 1087 IF (IW.NE.7) GO TO 1090                                           00090100
      IF (AR4(1).LT.1000.0) GO TO 1090                                  00090200
      DECODE(80,150,ARY) AR4(15)                                        00090300
 1088 IF (IW.NE.1) GO TO 1090                                           00090500
      AR4(3)=0.0                                                        00090600
      IF (AR4(2).NE.SFAT) GO TO 1090                                    00090700
      DECODE(80,160,ARY) AR4(3)                                         00090800
 1090 RETURN                                                            00091000
      END                                                               00091100
*DECK TBLP                                                              00091101
C     FUNCTION TBLP OF PROGRAM XF0031                                   00091200
C     L.W. FESLER     41-383/530  X4263                                 00091300
C                                                                       00091400
C                *****      *****      *****      *****                 00091500
C                                                                       00091600
C     THIS FUNCTION PREFORMS A DOUBLE LINEAR INTERPOLATION FROM DATA    00091700
C     ARRAY TBSTG AT THE SPECIFIED INDEPENDENT VARIABLES.               00091800
C                                                                       00091900
C                *****      *****      *****      *****                 00092000
C                                                                       00092100
C     LIST OF ARGUMENTS --                                              00092200
C       TBL - TABLE NUMBER OR DATA VALUE                                00092300
C       VR1 - INDEPENDENT VARIABLE 1                                    00092400
C       VR2 - INDEPENDENT VARIABLE 2                                    00092500
C       ICD - TEST FLAG    1 - TABLE OPTION                             00092600
C                                                                       00092700
C                *****      *****      *****      *****                 00092800
C                                                                       00092900
      FUNCTION TBLP(TBL,VR1,VR2,ICD)                                    00093000
C                                                                       00093100
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00093200
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00093300
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00093400
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00093500
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00093600
     5              ICLOCK,IDOMT,INPP(33)                               00093601
      COMMON /CMN3/ TBSTG(4000),TBID(14,99)                             00093700
      DIMENSION IBSTG(4000)                                             00093800
      EQUIVALENCE (TBSTG(1),IBSTG(1))                                   00093900
      COMMON /CMNY/ TT1,TT2,TT3,TT4,TT5,TT6,TT7                         00094000
C                                                                       00094100
 1000 IF (TBL.LT.0.0) GO TO 1010                                        00094200
      TBLP=TBL                                                          00094300
      GO TO 1095                                                        00094400
 1010 ICD=1                                                             00094500
      IF (ICLOCK.GT.0) CALL TIMEV(TT70)                                 00094600
      TT=-TBL                                                           00094700
      NTO=IBSTG(1)                                                      00094800
      DO 1020 I=1,NTO                                                   00094900
      NI=I                                                              00095000
      IF (TT.EQ.ABS(TBSTG(I+2))) GO TO 1025                             00095100
 1020 CONTINUE                                                          00095200
      VALUE=0.0                                                         00095300
      GO TO 1080                                                        00095400
 1025 LD=IBSTG(NI+101)                                                  00095500
      IDX=IBSTG(LD+1)                                                   00095600
      IF (IDX.LT.2) IDX=2                                               00095700
      NE=IBSTG(LD+2)                                                    00095800
      NW=IBSTG(LD+3)                                                    00095900
      NW1=NW+1                                                          00096000
      LDO=LD+13-NW                                                      00096100
      AR1=VR1                                                           00096200
      IF (TBSTG(NI+2).GT.0.0) GO TO 1030                                00096300
      IX=LDO+NE*NW1                                                     00096400
      CYC=TBSTG(IX)                                                     00096500
      AR1=AMOD(VR1,CYC)                                                 00096600
 1030 IF (IDX.EQ.2) GO TO 1035                                          00096700
      IX=LDO+IDX*NW1                                                    00096800
      IF (AR1.GT.TBSTG(IX)) GO TO 1035                                  00096900
      DO 1033 I=2,IDX                                                   00097000
      ISX=IDX+2-I                                                       00097100
      IX=LDO+(ISX-1)*NW1                                                00097200
      IF (AR1.GE.TBSTG(IX)) GO TO 1045                                  00097300
 1033 CONTINUE                                                          00097400
      GO TO 1045                                                        00097500
 1035 DO 1040 I=IDX,NE                                                  00097600
      ISX=I                                                             00097700
      IX=LDO+ISX*NW1                                                    00097800
      IF (AR1.LT.TBSTG(IX)) GO TO 1045                                  00097900
 1040 CONTINUE                                                          00098000
 1045 ISX=MAX0(2,ISX)                                                   00098100
      ISX=MIN0(NE,ISX)                                                  00098200
      IS2=LDO+ISX*NW1                                                   00098300
      IS1=IS2-NW1                                                       00098400
      Y1=TBSTG(IS1+1)                                                   00098500
      Y2=TBSTG(IS2+1)                                                   00098600
      IF (NW.EQ.1) GO TO 1070                                           00098700
      DO 1050 J=2,NW                                                    00098800
      JS=J                                                              00098900
      KS=LD+6+J                                                         00099000
      IF (VR2.LT.TBSTG(KS)) GO TO 1060                                  00099100
 1050 CONTINUE                                                          00099200
 1060 JS1=JS+IS1                                                        00099300
      JS2=JS+IS2                                                        00099400
      RAT=(VR2-TBSTG(KS-1))/(TBSTG(KS)-TBSTG(KS-1))                     00099500
      Y1=TBSTG(JS1-1)+RAT*(TBSTG(JS1)-TBSTG(JS1-1))                     00099600
      Y2=TBSTG(JS2-1)+RAT*(TBSTG(JS2)-TBSTG(JS2-1))                     00099700
 1070 VALUE=Y1+((Y2-Y1)/(TBSTG(IS2)-TBSTG(IS1)))*(AR1-TBSTG(IS1))       00099800
 1080 TBLP=VALUE                                                        00099900
      IF (IBSTG(LD+1).NE.0) IBSTG(LD+1)=ISX                             00100000
 1090 IF (ICLOCK.LE.0) GO TO 1095                                       00100100
      CALL TIMEV(TT71)                                                  00100200
      TT7=TT7+(TT71-TT70)                                               00100300
 1095 RETURN                                                            00100400
      END                                                               00100500
*DECK HAIR                                                              00100501
C     FUNCTION HAIR OF PROGRAM XF0031                                   00100600
C     L.W. FESLER     41-383/530  X4263                                 00100700
C                                                                       00100800
C                *****      *****      *****      *****                 00100900
C                                                                       00101000
C     THIS FUNCTION CONTAINS THE ENTHALPY (BTU/LB) OF AIR AS            00101100
C     A FUNCTION OF (T,P).                                              00101200
C                                                                       00101300
C                *****      *****      *****      *****                 00101400
C                                                                       00101500
C     LIST OF ARGUMENTS --                                              00101600
C       T - TEMPERATURE (DEG F)                                         00101700
C       P - PRESSURE (PSF)                                              00101800
C                                                                       00101900
C                *****      *****      *****      *****                 00102000
C                                                                       00102100
      FUNCTION HAIR(T,P)                                                00102200
C                                                                       00102300
      DIMENSION TI(21),PJ(7),ARY(21,7),ARY1(21),ARY2(21),ARY3(21),      00102400
     1          ARY4(21),ARY5(21),ARY6(21),ARY7(21)                     00102500
      EQUIVALENCE (ARY(001),ARY1(1)),(ARY(022),ARY2(1)),                00102600
     1            (ARY(043),ARY3(1)),(ARY(064),ARY4(1)),                00102700
     2            (ARY(085),ARY5(1)),(ARY(106),ARY6(1)),                00102800
     3            (ARY(127),ARY7(1))                                    00102900
C                                                                       00103000
      DATA TI / -300.0,-100.0, 260.0, 620.0, 980.0,1340.0,1700.0,       00103100
     1          2060.0,2420.0,2780.0,3140.0,3500.0,3860.0,4220.0,       00103200
     2          4580.0,4940.0,5300.0,5660.0,6020.0,6380.0,6740.0 /      00103300
      DATA PJ / 0.00001,0.0001,0.001,0.01,0.1,1.0,10.0 /                00103400
      DATA ARY1 /   36.0,  80.0, 170.0, 260.0, 350.0, 450.0, 550.0,     00103500
     1             650.0, 760.0, 870.0,1320.0,2070.0,2670.0,2890.0,     00103600
     2            3040.0,3180.0,3360.0,3690.0,4300.0,5430.0,7400.0 /    00103700
      DATA ARY2 /   36.0,  80.0, 170.0, 260.0, 350.0, 450.0, 550.0,     00103800
     1             650.0, 760.0, 870.0,1100.0,1500.0,2180.0,2735.0,     00103900
     2            2980.0,3140.0,3280.0,3480.0,3740.0,4180.0,4950.0 /    00104000
      DATA ARY3 /   36.0,  80.0, 170.0, 260.0, 350.0, 450.0, 550.0,     00104100
     1             650.0, 760.0, 870.0,1020.0,1240.0,1630.0,2200.0,     00104200
     2            2730.0,3040.0,3230.0,3380.0,3560.0,3780.0,4100.0 /    00104300
      DATA ARY4 /   36.0,  80.0, 170.0, 260.0, 350.0, 450.0, 550.0,     00104400
     1             650.0, 760.0, 870.0,1000.0,1140.0,1360.0,1690.0,     00104500
     2            2150.0,2660.0,3030.0,3280.0,3460.0,3630.0,3820.0 /    00104600
      DATA ARY5 /   36.0,  80.0, 170.0, 260.0, 350.0, 450.0, 550.0,     00104700
     1             650.0, 760.0, 870.0, 990.0,1120.0,1270.0,1460.0,     00104800
     2            1730.0,2080.0,2500.0,2900.0,3220.0,3470.0,3660.0 /    00104900
      DATA ARY6 /   36.0,  80.0, 170.0, 260.0, 350.0, 450.0, 550.0,     00105000
     1             650.0, 760.0, 870.0, 990.0,1110.0,1235.0,1380.0,     00105100
     2            1560.0,1760.0,2030.0,2340.0,2680.0,3030.0,3330.0 /    00105200
      DATA ARY7 /   36.0,  80.0, 170.0, 260.0, 350.0, 450.0, 550.0,     00105300
     1             650.0, 760.0, 870.0, 990.0,1110.0,1225.0,1360.0,     00105400
     2            1500.0,1650.0,1820.0,2030.0,2260.0,2520.0,2780.0 /    00105500
C                                                                       00105600
 1000 PA=P/(14.696*144.0)                                               00105700
      DO 1010 I=2,21                                                    00105800
      IS2=I                                                             00105900
      IF (T.LE.TI(I)) GO TO 1020                                        00106000
 1010 CONTINUE                                                          00106100
 1020 IS1=IS2-1                                                         00106200
      DO 1030 J=2,7                                                     00106300
      JS2=J                                                             00106400
      IF (PA.LE.PJ(J)) GO TO 1040                                       00106500
 1030 CONTINUE                                                          00106600
 1040 JS1=JS2-1                                                         00106700
      RI=(T-TI(IS1))/(TI(IS2)-TI(IS1))                                  00106800
      RJ=(PA-PJ(JS1))/(PJ(JS2)-PJ(JS1))                                 00106900
      Y1=(1.0-RI)*ARY(IS1,JS1)+RI*ARY(IS2,JS1)                          00107000
      Y2=(1.0-RI)*ARY(IS1,JS2)+RI*ARY(IS2,JS2)                          00107100
      HAIR=(1.0-RJ)*Y1+RJ*Y2                                            00107200
 1090 RETURN                                                            00107300
      END                                                               00107400
*DECK SYMB                                                              00107401
C     FUNCTION SYMB OF PROGRAM XF0031                                   00107500
C     L.W. FESLER     41-383/530  X4263                                 00107600
C                                                                       00107700
C                *****      *****      *****      *****                 00107800
C                                                                       00107900
C     THIS FUNCTION PLOTS THE ENTRY AND TOUCHDOWN SYMBOLS.              00108000
C                                                                       00108100
C                *****      *****      *****      *****                 00108200
C                                                                       00108300
C     LIST OF ARGUMENTS --                                              00108400
C       TENRY - ENTRY TIME                                              00108500
C       TDOWN - TOUCHDOWN TIME                                          00108600
C                                                                       00108700
C                *****      *****      *****      *****                 00108800
C                                                                       00108900
      FUNCTION SYMB(TENRY,TDOWN,IFLAG)                                  00109000
C                                                                       00109100
 1000 DO 1020 IS=1,2                                                    00109200
      IF (IS.EQ.1) IXD=NXV(TENRY)                                       00109300
      IF (IS.EQ.2) IXD=NXV(TDOWN)                                       00109400
      IYD=40                                                            00109500
      IYP=15                                                            00109600
      IF (IFLAG.GT.3) IYD=64                                            00109700
      IF (IFLAG.GT.3) IYP=41                                            00109800
      IF (IS.EQ.1) IXP=IXD-19                                           00109900
      IF (IS.EQ.2) IXP=IXD-34                                           00110000
      IF (IXP.LT.24) IXP=24                                             00110100
      IF (IXP.GT.990) IXP=990                                           00110200
      IF (IS.EQ.1) CALL PRINTV(5,"ENTRY",IXP,IYP)                       00110300
      IF (IS.EQ.2) CALL PRINTV(9,"TOUCHDOWN",IXP,IYP)                   00110400
      DO 1010 I=1,12,2                                                  00110500
      IXR=IXD+I                                                         00110600
      IXL=IXD-I                                                         00110700
      IYB=IYD+2*(12-I)                                                  00110800
      IYM=IYB+I                                                         00110900
      IYT=IYB+3*I                                                       00111000
      DO 1010 J=1,2                                                     00111100
      CALL LINEV(IXD,IYB,IXR,IYM)                                       00111200
      CALL LINEV(IXR,IYM,IXR,IYT)                                       00111300
      CALL LINEV(IXR,IYT,IXL,IYT)                                       00111400
      CALL LINEV(IXL,IYT,IXL,IYM)                                       00111500
      CALL LINEV(IXL,IYM,IXD,IYB)                                       00111600
 1010 CONTINUE                                                          00111700
 1020 CONTINUE                                                          00111800
 1080 SYMB=0.0                                                          00111900
 1090 RETURN                                                            00112000
      END                                                               00112100
*DECK FNSP                                                              00112101
C     FUNCTION FNSP                                                     00112200
C     L.W. FESLER     41-383/530  X4263                                 00112300
C                                                                       00112400
C                *****      *****      *****      *****                 00112500
C                                                                       00112600
C     THIS FUNCTION PERFORMS AN INTERPOLATION AND DETERMINES THE        00112700
C     SLOPE FROM DATA ARRAYS X(I) AND Y(I) AT THE SPECIFIED             00112800
C     INDEPENDENT VARIABLE.                                             00112900
C                                                                       00113000
C                *****      *****      *****      *****                 00113100
C                                                                       00113200
C     LIST OF ARGUMENTS --                                              00113300
C        IVAR  - FUNCTION FLAG                                          00113400
C                  1-VALUE                                              00113500
C                  2-SLOPE                                              00113600
C        ITYPE - METHOD USED                                            00113700
C                  1-LINEAR                                             00113800
C                  2-PARABOLIC                                          00113900
C                  3-DOUBLE PARABOLIC                                   00114000
C        N     - NUMBER OF POINTS FOR ARRAYS                            00114100
C        XO    - INDEPENDENT VARIABLE VALUE                             00114200
C        X(I)  - INDEPENDENT VARIABLE ARRAY                             00114300
C        Y(I)  - DEPENDENT VARIABLE ARRAY                               00114400
C                                                                       00114500
C                *****      *****      *****      *****                 00114600
C                                                                       00114700
      FUNCTION FNSP(IVAR,ITYPE,N,XO,X,Y)                                00114800
C                                                                       00114900
      DIMENSION X(1),Y(1)                                               00115000
C                                                                       00115100
 0100 DO 110 I=2,N                                                      00115200
      IS=I                                                              00115300
      IF (XO.LT.X(I)) GO TO 120                                         00115400
 0110 CONTINUE                                                          00115500
  120 IF (X(N).GT.X(1)) GO TO 125                                       00115600
      IF (XO.LT.X(N)) IS=N                                              00115700
  125 X2=X(IS-1)                                                        00115800
      Y2=Y(IS-1)                                                        00115900
      X3=X(IS)                                                          00116000
      Y3=Y(IS)                                                          00116100
      Y1=0.0                                                            00116200
      Y4=0.0                                                            00116300
      SLOPE=(Y3-Y2)/(X3-X2)                                             00116400
      VALUE=Y2+SLOPE*(XO-X2)                                            00116500
      IF (ITYPE.EQ.1) GO TO 180                                         00116600
      IF (N.EQ.2) GO TO 180                                             00116700
      IF (IS.EQ.2) GO TO 140                                            00116800
      IF (IS.EQ.N) GO TO 160                                            00116900
      IF (ITYPE.EQ.3) GO TO 130                                         00117000
      IF ((X3-XO).LT.(XO-X2)) GO TO 150                                 00117100
 0130 X1=X(IS-2)                                                        00117200
      Y1=Y(IS-2)                                                        00117300
      DD=(X1-X2)*(X1-X3)*(X2-X3)                                        00117400
      DN=(Y1-Y2)*(X1-X3)-(Y1-Y3)*(X1-X2)                                00117500
      A1=DN/DD                                                          00117600
      A2=((Y1-Y2)-A1*(X1**2-X2**2))/(X1-X2)                             00117700
      A3=Y1-A1*X1**2-A2*X1                                              00117800
      VALUE=A1*XO**2+A2*XO+A3                                           00117900
      SLOPE=2.0*A1*XO+A2                                                00118000
      IF (IS.EQ.2) GO TO 140                                            00118100
      IF (IS.EQ.N) GO TO 140                                            00118200
      IF (ITYPE.EQ.2) GO TO 180                                         00118300
 0140 V1=VALUE                                                          00118400
      S1=SLOPE                                                          00118500
      DEL1=ABS(Y2-Y1)                                                   00118600
      IF (IS.EQ.2) DEL1=ABS(Y3-Y2)                                      00118700
      DEL1=AMAX1(DEL1,0.000001)                                         00118800
      IF (IS.EQ.2) GO TO 150                                            00118900
      IF (ITYPE.EQ.2) GO TO 170                                         00119000
      IF (IS.EQ.N) GO TO 170                                            00119100
 0150 X4=X(IS+1)                                                        00119200
      Y4=Y(IS+1)                                                        00119300
      DD=(X2-X3)*(X2-X4)*(X3-X4)                                        00119400
      DN=(Y2-Y3)*(X2-X4)-(Y2-Y4)*(X2-X3)                                00119500
      A1=DN/DD                                                          00119600
      A2=((Y2-Y3)-A1*(X2**2-X3**2))/(X2-X3)                             00119700
      A3=Y2-A1*X2**2-A2*X2                                              00119800
      VALUE=A1*XO**2+A2*XO+A3                                           00119900
      SLOPE=2.0*A1*XO+A2                                                00120000
      IF (IS.EQ.2) GO TO 160                                            00120100
      IF (ITYPE.EQ.2) GO TO 180                                         00120200
 0160 V2=VALUE                                                          00120300
      S2=SLOPE                                                          00120400
      DEL2=ABS(Y3-Y4)                                                   00120500
      IF (IS.EQ.N) DEL2=ABS(Y3-Y2)                                      00120600
      DEL2=AMAX1(DEL2,0.000001)                                         00120700
      IF (IS.EQ.N) GO TO 130                                            00120800
 0170 VALUE=(DEL1*V2+DEL2*V1)/(DEL1+DEL2)                               00120900
      SLOPE=(DEL1*S2+DEL2*S1)/(DEL1+DEL2)                               00121000
 0180 IF (IVAR.EQ.1) FNSP=VALUE                                         00121100
      IF (IVAR.EQ.2) FNSP=SLOPE                                         00121200
 0190 RETURN                                                            00121300
      END                                                               00121400
*DECK IPDA                                                              00121401
C     FUNCTION IPDA OF PROGRAM XF0031                                   00121500
C     L.W. FESLER     41-383/530  X4263                                 00121600
C                                                                       00121700
C                *****      *****      *****      *****                 00121800
C                                                                       00121900
C     THIS FUNCTION CONTAINS MATERIAL PROPERTIES DATA IN FORMAT TO      00122000
C     BE USED AS TABLES FOR PROGRAM XF0031.                             00122100
C                                                                       00122200
C                *****      *****      *****      *****                 00122300
C                                                                       00122400
C     LIST OF ARGUMENTS --                                              00122500
C       IDEX - INDEX FOR TABLE STORAGE                                  00122600
C       NE   - NUMBER OF ENTRIES                                        00122700
C       NC   - NUMBER OF CURVES                                         00122800
C                                                                       00122900
C                *****      *****      *****      *****                 00123000
C                                                                       00123100
      FUNCTION IPDA(IDEX,NE,NC)                                         00123200
C                                                                       00123300
      COMMON /CMN3/ TBSTG(4000),TBID(14,99)                             00123400
      DIMENSION IBSTG(4000)                                             00123500
      EQUIVALENCE (TBSTG(1),IBSTG(1))                                   00123600
      DIMENSION ARY(2630),TLE(14,144),LOC(144),INE(144),INC(144),       00123700
     1          T01(126),T02(126),T03(126),T04(126),T05(126),T06(126),  00123800
     2          T07(126),T08(126),T09(126),T10(126),T11(126),           00123900
     *          T12(126),T13(126),T14(126),T15(126),T16(126),           00123901
     3          A01(054),A02(091),A03(129),A04(111),A05(085),           00124000
     4          A06(070),A07(104),A08(105),A09(085),A10(136),           00124100
     5          A11(068),A12(115),A13(111),A14(095),A15(080),           00124200
     6          A16(104),A17(104),A18(067),A19(082),A20(066),           00124300
     7          A21(078),A22(042),A23(093),A24(071),A25(063),           00124400
     8          A26(086),A27(081),A28(094),A29(104),A30(056)            00124500
      EQUIVALENCE (TLE(1,01),T01(1)),(TLE(1,10),T02(1)),                00124600
     1            (TLE(1,19),T03(1)),(TLE(1,28),T04(1)),                00124700
     2            (TLE(1,37),T05(1)),(TLE(1,46),T06(1)),                00124800
     3            (TLE(1,55),T07(1)),(TLE(1,64),T08(1)),                00124900
     4            (TLE(1,73),T09(1)),(TLE(1,82),T10(1)),                00125000
     5            (TLE(1,91),T11(1)),(TLE(1,100),T12(1)),               00125100
     6            (TLE(1,109),T13(1)),(TLE(1,118),T14(1)),              00125101
     7            (TLE(1,127),T15(1)),(TLE(1,136),T16(1))               00125102
      EQUIVALENCE (ARY(0001),A01(1)),(ARY(0055),A02(1)),                00125200
     1            (ARY(0146),A03(1)),(ARY(0275),A04(1)),                00125300
     2            (ARY(0386),A05(1)),(ARY(0471),A06(1)),                00125400
     3            (ARY(0541),A07(1)),(ARY(0645),A08(1)),                00125500
     4            (ARY(0750),A09(1)),(ARY(0835),A10(1)),                00125600
     5            (ARY(0971),A11(1)),(ARY(1039),A12(1)),                00125700
     6            (ARY(1154),A13(1)),(ARY(1265),A14(1)),                00125800
     7            (ARY(1360),A15(1)),(ARY(1440),A16(1)),                00125900
     8            (ARY(1544),A17(1)),(ARY(1648),A18(1)),                00126000
     9            (ARY(1715),A19(1)),(ARY(1797),A20(1)),                00126100
     *            (ARY(1863),A21(1)),(ARY(1941),A22(1)),                00126200
     1            (ARY(1983),A23(1)),(ARY(2076),A24(1)),                00126300
     2            (ARY(2147),A25(1)),(ARY(2210),A26(1)),                00126400
     3            (ARY(2296),A27(1)),(ARY(2377),A28(1)),                00126401
     4            (ARY(2471),A29(1)),(ARY(2575),A30(1))                 00126402
C                                                                       00126500
      DATA LOC /    1,  18,  37,  46,  55, 108, 129, 146, 250, 275,     00126600
     1            302, 317, 340, 369, 386, 403, 420, 437, 454, 471,     00126700
     2            484, 511, 526, 541, 645, 672, 711, 750, 773, 820,     00126800
     3            835, 914, 929, 950, 971, 992, 999,1006,1013,1024,     00126900
     4           1039,1054,1063,1074,1143,1154,1244,1265,1288,1305,     00127000
     5           1360,1383,1406,1429,1440,1544,1648,1671,1694,1715,     00127100
     6           1736,1751,1772,1797,1810,1825,1852,1863,1888,1917,     00127200
     7           1930,1941,1952,1961,1972,1983,2054,2065,2076,2099,     00127300
     8           2126,2147,2172,2193,2210,2233,2256,2275,2296,2307,     00127400
     9           2332,2345,2364,2377,2400,2417,2438,2471,2575,2588,     00127500
     *           2601,2616,   0,   0,   0,   0,   0,   0,   0,   0,     00127501
     1              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00127502
     2              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00127503
     3              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00127504
     4              0,   0,   0,   0 /                                  00127505
      DATA INE /    8,   9,   4,   4,   8,  10,   8,  14,  12,   6,     00127600
     1              7,   9,  14,   8,   8,   8,   8,   8,   8,   6,     00127700
     2             13,   7,   7,  14,  13,  19,  19,  11,   7,   7,     00127800
     2              9,   7,  10,  10,  10,   3,   3,   3,   5,   7,     00127900
     4              7,   4,   5,   9,   5,  12,  10,   5,   8,   6,     00128000
     5             11,  11,  11,   5,  14,  14,   9,   9,  10,  10,     00128100
     6              7,  10,  12,   6,   7,  13,   5,  12,  14,   6,     00128200
     7              5,   5,   4,   5,   5,  11,   5,   5,  11,  13,     00128300
     8             10,  12,  10,   8,  11,  11,   9,  10,   5,  12,     00128400
     9              6,   9,   6,  11,   8,  10,  16,  14,   6,   6,     00128500
     *              7,   7,   0,   0,   0,   0,   0,   0,   0,   0,     00128501
     1              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00128502
     2              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00128503
     3              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00128504
     4              0,   0,   0,   0 /                                  00128505
      DATA INC /    1,   1,   1,   1,   5,   1,   1,   6,   1,   3,     00128600
     1              1,   1,   1,   1,   1,   1,   1,   1,   1,   1,     00128700
     2              1,   1,   1,   6,   1,   1,   1,   1,   5,   1,     00128800
     3              7,   1,   1,   1,   1,   1,   1,   1,   1,   1,     00128900
     4              1,   1,   1,   6,   1,   6,   1,   3,   1,   7,     00129000
     5              1,   1,   1,   1,   6,   6,   1,   1,   1,   1,     00129100
     6              1,   1,   1,   1,   1,   1,   1,   1,   1,   1,     00129200
     7              1,   1,   1,   1,   1,   5,   1,   1,   1,   1,     00129300
     8              1,   1,   1,   1,   1,   1,   1,   1,   1,   1,     00129400
     9              1,   1,   1,   1,   1,   1,   1,   6,   1,   1,     00129500
     *              1,   1,   0,   0,   0,   0,   0,   0,   0,   0,     00129501
     1              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00129502
     2              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00129503
     3              0,   0,   0,   0,   0,   0,   0,   0,   0,   0,     00129504
     4              0,   0,   0,   0 /                                  00129505
      DATA T01 / "ALUM","INUM"," (20","24-T","8XX)"," K(T","),  ",      00129600
     1           "    ","   R","HO=1","75.0",", DA","TE=7","5353",      00129700
     2           "ALUM","INUM"," (20","24-T","8XX)"," CP(","T), ",      00129800
     2           "    ","    ","    ","    ","  DA","TE=7","5353",      00129900
     3           "ALUM","INOS","ILIC","ATE ","GLAS","S K(","T), ",      00130000
     3           "    ","   R","HO=1","64.0",", DA","TE=7","5353",      00130100
     4           "ALUM","INOS","ILIC","ATE ","GLAS","S CP","(T),",      00130200
     4           "    ","    ","    ","    ","  DA","TE=7","5353",      00130300
     5           "ASTR","OQUA","RTZ ","K(T,","P), ","    ","    ",      00130400
     5           "    ","   R","HO=1",".1, ","  DA","TE=7","5353",      00130500
     6           "ASTR","OQUA","RTZ ","CP(T","),  ","    ","    ",      00130600
     6           "    ","    ","    ","    ","  DA","TE=7","8100",      00130700
     7           "COLU","MBIU","M (C","-103",") K(","T), ","    ",      00130800
     7           "    ","   R","HO=5","53.0",", DA","TE=7","7115",      00130900
     8           "DYNA","FLEX"," K(T",",P),","    ","    ","    ",      00131000
     8           "    ","   R","HO=6",".0, ","  DA","TE=7","8100",      00131100
     9           "DYNA","FLEX"," CP(","T), ","    ","    ","    ",      00131200
     9           "    ","    ","    ","    ","  DA","TE=7","9165" /     00131300
      DATA T02 / "S-GL","ASS ","FIBE","R BR","USH ","(1 H","T) K",      00131400
     1           "(T),","   R","HO=1","8.0,","  DA","TE=7","8100",      00131500
     2           "S-GL","ASS ","FIBE","R BR","USH ","(1 H","T) C",      00131600
     2           "P(T)",",   ","    ","    ","  DA","TE=7","8100",      00131700
     3           "FUSE","D SI","LICA"," FOA","M K(","T), ","    ",      00131800
     3           "    ","   R","HO=5","0.0,","  DA","TE=7","9092",      00131900
     4           "FUSE","D SI","LICA"," FOA","M CP","(T),","    ",      00132000
     4           "    ","    ","    ","    ","  DA","TE=7","6274",      00132100
     5           "GR/E","POXY"," (TA","PE R","EINF","-PAR",") K(",      00132200
     5           "T), ","   R","HO=9","8.4,","  DA","TE=7","5353",      00132300
     6           "GR/E","POXY"," (TA","PE R","EINF","-NOR",") K(",      00132400
     6           "T), ","   R","HO=9","8.4,","  DA","TE=7","5353",      00132500
     7           "GR/E","POXY"," (FA","BRIC"," REI","NF-P","AR) ",      00132600
     7           "K(T)",",  R","HO=9","8.4,","  DA","TE=7","5353",      00132700
     8           "GR/E","POXY"," (FA","BRIC"," REI","NF-N","OR) ",      00132800
     8           "K(T)",",  R","HO=9","8.4,","  DA","TE=7","5353",      00132900
     9           "GR/E","POXY"," (TP","+FAB"," REI","NF-P","AR) ",      00133000
     9           "K(T)",",  R","HO=9","8.4,","  DA","TE=7","5353" /     00133100
      DATA T03 / "GR/E","POXY"," (TP","+FAB"," REI","NF-N","OR) ",      00133200
     1           "K(T)",",  R","HO=9","8.4,","  DA","TE=7","5353",      00133300
     2           "GRAP","HITE","/EPO","XY C","P(T)",",   ","    ",      00133400
     2           "    ","    ","    ","    ","  DA","TE=7","5353",      00133500
     3           "HAYN","ES 2","5 (L","-605",") K(","T), ","    ",      00133600
     3           "    ","   R","HO=5","70.0",", DA","TE=7","5353",      00133700
     4           "HAYN","ES 1","88 K","(T),","    ","    ","    ",      00133800
     4           "    ","   R","HO=5","60.0",", DA","TE=7","5353",      00133900
     5           "HAYN","ES 1","88 C","P(T)",",   ","    ","    ",      00134000
     5           "    ","    ","    ","    ","  DA","TE=7","5353",      00134100
     6           "HRSI","-NOR"," K(T",",P),","    ","    ","    ",      00134200
     6           "    ","   R","HO=9",".0, ","  DA","TE=7","6274",      00134300
     7           "HRSI"," CP(","T), ","    ","    ","    ","    ",      00134400
     7           "    ","    ","    ","    ","  DA","TE=7","5353",      00134500
     8           "HRSI","/LRS","I CO","ATIN","G K(","T), ","    ",      00134600
     8           "    ","   R","HO=1","04.0",", DA","TE=7","6274",      00134700
     9           "HRSI","/LRS","I CO","ATIN","G CP","(T),","    ",      00134800
     9           "    ","    ","    ","    ","  DA","TE=7","6274" /     00134900
      DATA T04 / "INCO","NEL ","ALLO","Y 71","8 K(","T), ","    ",      00135000
     1           "    ","   R","HO=5","13.0",", DA","TE=7","5353",      00135100
     2           "MIN-","K 13","01 K","(T,P","),  ","    ","    ",      00135200
     2           "    ","   R","HO=2","0.0,","  DA","TE=7","5353",      00135300
     3           "MIN-","K 13","01 C","P(T)","    ","    ","    ",      00135400
     3           "    ","    ","    ","    ","  DA","TE=7","5353",      00135500
     4           "NOME","X FR","SI K","(T,P","),  ","    ","    ",      00135600
     4           "    ","   R","HO=5",".4, ","  DA","TE=7","6274",      00135700
     5           "NOME","X FR","SI C","P(T)",",   ","    ","    ",      00135800
     5           "    ","    ","    ","    ","  DA","TE=7","6274",      00135900
     6           "REIN","F CA","RBON","-CAR","BON ","(NOR",") K(",      00136000
     6           "T), ","   R","HO=1","03.4",", DA","TE=7","8100",      00136100
     7           "REIN","F CA","RBON","-CAR","BON ","(PAR",") K(",      00136200
     7           "T), ","   R","HO=1","03.4",", DA","TE=7","8100",      00136300
     8           "REIN","F CA","RBON","-CAR","BON ","CP(T","),  ",      00136400
     8           "    ","    ","    ","    ","  DA","TE=7","8100",      00136500
     9           "REFR","ASIL"," UC1","00-4","8 CL","OTH-","1LYR",      00136600
     9           " K(T","), R","HO=5","6.51",", DA","TE=7","5353" /     00136700
      DATA T05 / "REFR","ASIL"," UC1","00-4","8 CL","OTH-","2LYR",      00136800
     1           " K(T","), R","HO=5","0.1,","  DA","TE=7","5353",      00136900
     2           "REFR","ASIL"," UC1","00-4","8 CL","OTH-","6LYR",      00137000
     2           " K(T","), R","HO=4","4.7,","  DA","TE=7","5353",      00137100
     3           "REFR","ASIL"," UC1","00-4","8 CL","OTH ","CP(T",      00137200
     3           "),  ","    ","    ","    ","  DA","TE=7","5353",      00137300
     4           "RENE"," 41 ","NICK","EL A","LLOY"," K(T","),  ",      00137400
     4           "    ","   R","HO=5","15.0",", DA","TE=7","5353",      00137500
     5           "RENE"," 41 ","NICK","EL A","LLOY"," CP(","T), ",      00137600
     5           "    ","    ","    ","    ","  DA","TE=7","5353",      00137700
     6           "SPRA","Y-ON"," FOA","M IN","SULA","TION"," K(T",      00137800
     6           "),  ","   R","HO=2",".0, ","  DA","TE=7","5353",      00137900
     7           "SPRA","Y-ON"," FOA","M IN","SULA","TION"," CP(",      00138000
     7           "T), ","    ","    ","    ","  DA","TE=7","5353",      00138100
     8           "NOME","X SI","P AN","D FI","LLER"," BAR"," K(T",      00138200
     8           ",P),","   R","HO=1","7-28",", DA","TE=7","6274",      00138300
     9           "STEE","L AL","LOY ","(A-2","86) ","K(T)",",   ",      00138400
     9           "    ","   R","HO=4","96.0",", DA","TE=7","5353" /     00138500
      DATA T06 / "THER","MOFL","EX I","NSUL","ATIO","N K(","T,P)",      00138600
     1           "    ","   R","HO=6",".0, ","  DA","TE=7","8100",      00138700
     2           "THER","MOFL","EX I","NSUL","ATIO","N CP","(T),",      00138800
     2           "    ","    ","    ","    ","  DA","TE=7","5353",      00138900
     3           "TG-1","5000"," INS","ULAT","ION ","K(T,","P), ",      00139000
     3           "    ","   R","HO=2",".0, ","  DA","TE=7","6105",      00139100
     4           "TG-1","5000"," INS","ULAT","ION ","CP(T","),  ",      00139200
     4           "    ","    ","    ","    ","  DA","TE=7","5353",      00139300
     5           "TG-1","5000"," INS","ULAT","ION ","K(T,","P), ",      00139400
     5           "    ","   R","HO=3",".0, ","  DA","TE=7","6105",      00139500
     6           "TITA","NIUM"," (6A","L-4V",") K(","T), ","    ",      00139600
     6           "    ","   R","HO=2","77.0",", DA","TE=7","6105",      00139700
     7           "TITA","NIUM"," (6A","L-4V",") CP","(T),","    ",      00139800
     7           "    ","    ","    ","    ","  DA","TE=7","6105",      00139900
     8           "STAI","NLES","S ST","EEL ","(17-","4PH)"," K(T",      00140000
     8           "),  ","   R","HO=4","89.0",", DA","TE=7","5353",      00140100
     9           "STAI","NLES","S ST","EEL ","(17-","4PH)"," CP(",      00140200
     9           "T), ","    ","    ","    ","  DA","TE=7","5353" /     00140300
      DATA T07 / "DYNA","FLEX"," K(T",",P),","    ","    ","    ",      00140400
     1           "    ","   R","HO=1","2.0,","  DA","TE=7","8100",      00140500
     2           "DYNA","FLEX"," K(T",",P),","    ","    ","    ",      00140600
     2           "    ","   R","HO=2","4.0,","  DA","TE=7","8100",      00140700
     3           "FUSE","D SI","LICA"," FOA","M K(","T), ","    ",      00140800
     3           "    ","   R","HO=3","0.0,","  DA","TE=7","9092",      00140900
     4           "FUSE","D SI","LICA"," FOA","M K(","T), ","    ",      00141000
     4           "    ","   R","HO=1","15.0",", DA","TE=7","9092",      00141100
     5           "PHEN","OLIC"," GLA","SS L","AMIN","ATE-","PAR ",      00141200
     5           "K(T)",",  R","HO=1","04.0",", DA","TE=7","6105",      00141300
     6           "PHEN","OLIC"," GLA","SS L","AMIN","ATE-","NOR ",      00141400
     6           "K(T)",",  R","HO=1","04.0",", DA","TE=7","6105",      00141500
     7           "PHEN","OLIC"," GLA","SS L","AMIN","ATE ","CP(T",      00141600
     7           "),  ","    ","    ","    ","  DA","TE=7","6105",      00141700
     8           "IRIS","H RE","FRAS","IL (","C155","4-48",") K(",      00141800
     8           "T), ","   R","HO=6","1.5,","  DA","TE=7","6274",      00141900
     9           "IRIS","H RE","FRAS","IL (","C155","4-48",") CP",      00142000
     9           "(T),","    ","    ","    ","  DA","TE=7","6105" /     00142100
      DATA T08 / "ELAS","TOME","R (R","TV56","0) K","(T),","    ",      00142200
     1           "    ","   R","HO=8","8.0,","  DA","TE=7","6105",      00142300
     2           "ELAS","TOME","R (R","TV56","0) C","P(T)",",   ",      00142400
     2           "    ","    ","    ","    ","  DA","TE=7","6105",      00142500
     3           "ALUM","INUM"," (22","19-T","8XX)"," K(T","),  ",      00142600
     3           "    ","   R","HO=1","76.0",", DA","TE=7","6105",      00142700
     4           "ALUM","INUM"," (22","19-T","8XX)"," CP(","T), ",      00142800
     4           "    ","    ","    ","    ","  DA","TE=7","6105",      00142900
     5           "INCO","NEL ","X-75","0 K(","T), ","    ","    ",      00143000
     5           "    ","   R","HO=5","15.0",", DA","TE=7","6105",      00143100
     6           "INCO","NEL ","X-75","0 CP","(T),","    ","    ",      00143200
     6           "    ","    ","    ","    ","  DA","TE=7","6105",      00143300
     7           "FUSE","D SI","LICA"," GLA","SS K","(T),","    ",      00143400
     7           "    ","   R","HO=1","37.0",", DA","TE=7","6105",      00143500
     8           "FUSE","D SI","LICA"," GLA","SS C","P(T)",",   ",      00143600
     8           "    ","    ","    ","    ","  DA","TE=7","6105",      00143700
     9           "POLY","IMID","E/GL","ASS ","LAMI","NATE","-PAR",      00143800
     9           " K(T","), R","HO=1","06.0",", DA","TE=7","8100" /     00143900
      DATA T09 / "POLY","IMID","E/GL","ASS ","LAMI","NATE","-NOR",      00144000
     1           " K(T","), R","HO=1","06.0",", DA","TE=7","8100",      00144100
     2           "PYRO","LYTI","C GR","APHI","TE-P","AR K","(T),",      00144200
     2           "    ","   R","HO=1","37.0",", DA","TE=7","6274",      00144300
     3           "PYRO","LYTI","C GR","APHI","TE-N","OR K","(T),",      00144400
     3           "    ","   R","HO=1","37.0",", DA","TE=7","6274",      00144500
     4           "HRSI","-PAR"," K(T",",P),","    ","    ","    ",      00144600
     4           "    ","   R","HO=9",".0, ","  DA","TE=7","6274",      00144700
     5           "SILI","CON ","NITR","IDE ","K(T)",",   ","    ",      00144800
     5           "    ","   R","HO=2","10.0",", DA","TE=7","6274",      00144900
     6           "ZIRC","ONIA"," FIB","ERS ","K(T)",",   ","    ",      00145000
     6           "    ","   R","HO=6",".0, ","  DA","TE=7","6274",      00145100
     7           "BERY","LLIU","M K(","T), ","    ","    ","    ",      00145200
     7           "    ","   R","HO=1","15.0",", DA","TE=7","6274",      00145300
     8           "BERY","LLIU","M CP","(T),","    ","    ","    ",      00145400
     8           "    ","    ","    ","    ","  DA","TE=7","6274",      00145500
     9           "COPP","ER K","(T),","    ","    ","    ","    ",      00145600
     9           "    ","   R","HO=5","58.0",", DA","TE=7","6274" /     00145700
      DATA T10 / "COPP","ER C","P(T)",",   ","    ","    ","    ",      00145800
     1           "    ","    ","    ","    ","  DA","TE=7","6274",      00145900
     2           "HAST","ELLO","Y C ","K(T)",",   ","    ","    ",      00146000
     2           "    ","   R","HO=5","58.0",", DA","TE=7","6274",      00146100
     3           "HAST","ELLO","Y C ","CP(T","),  ","    ","    ",      00146200
     3           "    ","    ","    ","    ","  DA","TE=7","6274",      00146300
     4           "INCO","NEL ","ALLO","Y 60","1 K(","T), ","    ",      00146400
     4           "    ","   R","HO=5","03.0",", DA","TE=7","6274",      00146500
     5           "INCO","NEL ","ALLO","Y 60","1 CP","(T),","    ",      00146600
     5           "    ","    ","    ","    ","  DA","TE=7","6274",      00146700
     6           "SILV","ER K","(T),","    ","    ","    ","    ",      00146800
     6           "    ","   R","HO=6","56.0",", DA","TE=7","6274",      00146900
     7           "SILV","ER C","P(T)",",   ","    ","    ","    ",      00147000
     7           "    ","    ","    ","    ","  DA","TE=7","6274",      00147100
     8           "ALUM","INA ","FIBE","R K(","T), ","    ","    ",      00147200
     8           "    ","   R","HO=6",".0, ","  DA","TE=7","7115",      00147300
     9           "INCO","NEL ","ALLO","Y 60","0 K(","T), ","    ",      00147400
     9           "    ","   R","HO=5","25.5",", DA","TE=7","7115" /     00147500
      DATA T11 / "INCO","NEL ","ALLO","Y 60","0 CP","(T),","    ",      00147600
     1           "    ","    ","    ","    ","  DA","TE=7","7115",      00147601
     2           "INCO","NEL ","ALLO","Y 62","5 K(","T), ","    ",      00147602
     2           "    ","   R","HO=5","27.0",", DA","TE=7","7115",      00147603
     3           "INCO","NEL ","ALLO","Y 62","5 CP","(T),","    ",      00147604
     3           "    ","    ","    ","    ","  DA","TE=7","7115",      00147605
     4           "STEE","L TY","PE 3","21 K","(T),","    ","    ",      00147606
     4           "    ","   R","HO=5","01.1",", DA","TE=7","7115",      00147607
     5           "STEE","L TY","PE 3","21 C","P(T)",",   ","    ",      00147608
     5           "    ","    ","    ","    ","  DA","TE=7","7115",      00147609
     6           "STEE","L TY","PE 4","10 K","(T),","    ","    ",      00147610
     6           "    ","   R","HO=4","83.8",", DA","TE=7","7115",      00147611
     7           "STEE","L TY","PE 4","10 C","P(T)",",   ","    ",      00147612
     7           "    ","    ","    ","    ","  DA","TE=7","7115",      00147613
     8           "DYNA","FLEX"," K(T",",P),","    ","    ","    ",      00147614
     8           "    ","   R","HO=8",".0, ","  DA","TE=7","8100",      00147615
     9           "MP35","N (M","ULTI","PHAS","E) K","(T),","    ",      00147616
     9           "    ","   R","HO=5","25.3",", DA","TE=7","8100" /     00147617
      DATA T12 / "STEE","L TY","PE 3","16 K","(T),","    ","    ",      00147618
     1           "    ","   R","HO=5","01.1",", DA","TE=7","8100",      00147619
     2           "STEE","L TY","PE 3","16 C","P(T)",",   ","    ",      00147620
     2           "    ","    ","    ","    ","  DA","TE=7","8100",      00147621
     3           "STEE","L (2","1-6-","9) K","(T),","    ","    ",      00147622
     3           "    ","   R","HO=4","89.0",", DA","TE=7","8100",      00147623
     4           "    ","    ","    ","    ","    ","    ","    ",      00147624
     4           "    ","    ","    ","    ","    ","    ","    ",      00147625
     5           "    ","    ","    ","    ","    ","    ","    ",      00147626
     5           "    ","    ","    ","    ","    ","    ","    ",      00147627
     6           "    ","    ","    ","    ","    ","    ","    ",      00147628
     6           "    ","    ","    ","    ","    ","    ","    ",      00147629
     7           "    ","    ","    ","    ","    ","    ","    ",      00147630
     7           "    ","    ","    ","    ","    ","    ","    ",      00147631
     8           "    ","    ","    ","    ","    ","    ","    ",      00147632
     8           "    ","    ","    ","    ","    ","    ","    ",      00147633
     9           "    ","    ","    ","    ","    ","    ","    ",      00147634
     9           "    ","    ","    ","    ","    ","    ","    " /     00147635
      DATA T13 / 126*1H  /                                              00147636
      DATA T14 / 126*1H  /                                              00147637
      DATA T15 / 126*1H  /                                              00147638
      DATA T16 / 126*1H  /                                              00147639
      DATA A01 /    0.0,                                                00147700
     1           -300.0,  61.2,-200.0,  69.6,   0.0,  84.0,             00147800
     2            200.0,  95.0, 300.0,  99.0, 400.0, 102.5,             00147900
     3            600.0, 104.5, 700.0, 104.5,                           00148000
     *              0.0,                                                00148100
     1           -420.0, 0.082,-400.0, 0.088,-300.0, 0.117,             00148200
     2           -200.0, 0.147,   0.0, 0.195, 200.0, 0.216,             00148300
     3            300.0, 0.224, 400.0, 0.233, 600.0, 0.250,             00148400
     *              0.0,                                                00148500
     1           -200.0,  0.57, 200.0,  0.81, 300.0,  0.84,             00148600
     2           1200.0,  0.86,                                         00148700
     *              0.0,                                                00148800
     1           -200.0, 0.135, 150.0,  0.19, 800.0, 0.257,             00148900
     2           1200.0, 0.283 /                                        00149000
      DATA A02 / 0.5569, 2.784, 27.84, 278.4,2116.0,                    00149100
     1            200.0, 0.029, 0.035, 0.045, 0.055, 0.074,             00149200
     2            300.0, 0.029, 0.035, 0.045, 0.055, 0.074,             00149300
     3            600.0, 0.067, 0.080, 0.111, 0.127, 0.147,             00149400
     4            800.0, 0.103, 0.120, 0.145, 0.164, 0.184,             00149500
     5           1000.0, 0.161, 0.182, 0.205, 0.226, 0.255,             00149600
     6           1200.0, 0.260, 0.285, 0.303, 0.328, 0.364,             00149700
     7           1400.0, 0.410, 0.427, 0.451, 0.480, 0.519,             00149800
     8           1500.0, 0.410, 0.427, 0.451, 0.480, 0.519,             00149900
     *              0.0,                                                00150000
     *            147.0,  0.18, 148.0,  0.18, 200.0,  0.20,             00150001
     1            266.0,  0.22, 400.0,  0.23, 600.0,  0.25,             00150100
     2            800.0,  0.26,1000.0,  0.27,1200.0,  0.28,             00150200
     3           1400.0,  0.29,                                         00150300
     *              0.0,                                                00150400
     1           -200.0,  17.0,  72.0,  19.7, 392.0,  22.3,             00150500
     2            752.0,  25.1,1112.0,  27.7,1832.0,  31.2,             00150501
     3           2372.0,  33.5,3000.0,  36.0 /                          00150502
      DATA A03 / 0.0278,0.2784, 2.784, 27.84, 278.4,2116.2,             00150600
     1           -200.0,0.0025,0.0042,0.0083,0.0100,0.0108,0.0108,      00150700
     2              0.0,0.0033,0.0050,0.0108,0.0158,0.0167,0.0167,      00150800
     3            200.0,0.0042,0.0058,0.0142,0.0217,0.0225,0.0233,      00150900
     4            400.0,0.0075,0.0092,0.0175,0.0283,0.0308,0.0308,      00151000
     5            600.0,0.0142,0.0150,0.0250,0.0375,0.0408,0.0417,      00151100
     6            800.0,0.0250,0.0258,0.0358,0.0508,0.0558,0.0558,      00151200
     7           1000.0,0.0417,0.0433,0.0525,0.0708,0.0758,0.0767,      00151300
     8           1200.0,0.0667,0.0683,0.0775,0.0975,0.1042,0.1050,      00151400
     9           1400.0,0.1017,0.1025,0.1125,0.1342,0.1417,0.1425,      00151500
     *           1600.0,0.1475,0.1492,0.1583,0.1817,0.1908,0.1917,      00151600
     1           1800.0,0.2075,0.2092,0.2183,0.2433,0.2533,0.2550,      00151700
     2           2000.0,0.2833,0.2842,0.2942,0.3200,0.3317,0.3333,      00151800
     3           2200.0,0.3767,0.3775,0.3875,0.4150,0.4275,0.4292,      00151801
     4           2400.0,0.4900,0.4917,0.5008,0.5292,0.5433,0.5450,      00151802
     *              0.0,                                                00151900
     1            153.0,  0.20, 225.0,  0.22, 297.0,  0.22,             00152000
     2            369.0,  0.23, 441.0,  0.23, 513.0,  0.24,             00152100
     3            585.0,  0.24, 657.0,  0.25, 729.0,  0.25,             00152200
     4            873.0,  0.25, 945.0,  0.26, 999.0,  0.26 /            00152300
      DATA A04 / 0.0278,  2.78,2116.2,                                  00152600
     1    -100.0, 0.041, 0.065, 0.083,   0.0, 0.049, 0.075, 0.095,      00152601
     2     200.0, 0.070, 0.101, 0.124, 500.0, 0.109, 0.146, 0.173,      00152602
     3    1000.0, 0.257, 0.308, 0.334,1400.0, 0.525, 0.555, 0.563,      00152603
     *       0.0,  32.0, 0.172, 146.0, 0.190, 263.0, 0.230,1202.0,      00152700
     1     0.240,1562.0, 0.250,1652.0, 0.250,1832.0, 0.258,             00152800
     *              0.0,                                                00153000
     1           -400.0, 0.070,   0.0, 0.080,                           00153100
     2            400.0, 0.100, 800.0, 0.120,                           00153200
     3           1200.0, 0.140,1600.0, 0.170,                           00153400
     4           2000.0, 0.230,2400.0, 0.320,                           00153401
     5           2800.0, 0.500, 4*0.0,                                  00153500
     1 0.0,      -200.0, 0.095,   0.0, 0.150, 200.0, 0.175,             00153700
     2            400.0, 0.195, 600.0, 0.220, 800.0, 0.240,             00153800
     3           1000.0, 0.260,1200.0, 0.280,1400.0, 0.300,             00153900
     4           1600.0, 0.315,2000.0, 0.343,2300.0, 0.355,             00154000
     5           2500.0, 0.360,3000.0, 0.360,                           00154100
     1 0.0,      -300.0,  0.80,-290.0,  0.80,-150.0,  1.73,             00154300
     2            -50.0,  2.29, 100.0,  2.93, 200.0,  3.21,             00154400
     3            300.0,  3.42, 400.0,  3.42 /                          00154500
      DATA A05 /    0.0,                                                00154600
     1           -300.0,  0.19,-290.0,  0.19,-150.0,  0.31,             00154700
     2            -50.0,  0.38, 100.0,  0.47, 200.0,  0.52,             00154800
     3            300.0,  0.54, 400.0,  0.54,                           00154900
     *              0.0,                                                00155000
     1           -300.0,  0.48,-290.0,  0.48,-150.0,  1.03,             00155100
     2            -50.0,  1.37, 100.0,  1.76, 200.0,  1.96,             00155200
     3            300.0,  2.08, 400.0,  2.08,                           00155300
     *              0.0,                                                00155400
     1           -300.0,  0.21,-290.0,  0.21,-150.0,  0.33,             00155500
     2            -50.0,  0.40, 100.0,  0.49, 200.0,  0.53,             00155600
     3            300.0,  0.57, 400.0,  0.57,                           00155700
     *              0.0,                                                00155800
     1           -300.0,  0.58,-290.0,  0.58,-150.0,  1.19,             00155900
     2            -50.0,  1.51, 100.0,  1.96, 200.0,  2.14,             00156000
     3            300.0,  2.29, 400.0,  2.29,                           00156100
     *              0.0,                                                00156200
     1           -300.0,  0.15,-290.0,  0.15,-150.0,  0.23,             00156300
     2            -50.0,  0.28, 100.0,  0.36, 200.0,  0.39,             00156400
     3            300.0,  0.43, 400.0,  0.43 /                          00156500
      DATA A06 /    0.0,                                                00156600
     1           -400.0, 0.049,-300.0, 0.049,-100.0, 0.132,             00156700
     2            100.0, 0.208, 300.0, 0.277, 350.0, 0.291,             00156800
     *              0.0,                                                00156900
     1              0.0,   4.6, 200.0,   6.1, 400.0,   7.3,             00157000
     2            600.0,   8.6, 800.0,   9.9,1000.0,  11.2,             00157100
     3           1200.0,  12.4,1400.0,  13.7,1500.0,  14.3,             00157200
     4           1600.0,  15.0,1700.0,  15.9,1800.0,  16.3,             00157300
     5           2000.0,  17.6,                                         00157400
     *              0.0,                                                00157500
     1              0.0,   5.2, 400.0,   7.8, 800.0,  10.2,             00157600
     2           1200.0,  12.7,1600.0,  15.2,2000.0,  17.5,             00157700
     3           2200.0,  17.9,                                         00157800
     *              0.0,                                                00157900
     1              0.0, 0.095, 400.0, 0.105, 800.0, 0.115,             00158000
     2           1200.0, 0.125,1600.0, 0.135,2000.0, 0.145,             00158100
     3           2200.0, 0.150 /                                        00158200
      DATA A07 /    0.0,0.2116, 2.116, 21.16, 211.6,2116.0,             00158300
     1           -250.0,0.0050,0.0050,0.0075,0.0150,0.0216,0.0233,      00158400
     3              0.0,0.0075,0.0075,0.0100,0.0183,0.0250,0.0275,      00158500
     4            250.0,0.0092,0.0092,0.0125,0.0225,0.0316,0.0341,      00158600
     5            500.0,0.0125,0.0125,0.0167,0.0276,0.0400,0.0433,      00158700
     6            750.0,0.0175,0.0175,0.0216,0.0325,0.0492,0.0534,      00158800
     7           1000.0,0.0233,0.0233,0.0275,0.0392,0.0600,0.0658,      00158900
     8           1250.0,0.0308,0.0308,0.0350,0.0492,0.0725,0.0782,      00159000
     9           1500.0,0.0416,0.0416,0.0459,0.0617,0.0875,0.0942,      00159100
     1           1750.0,0.0567,0.0567,0.0610,0.0767,0.1060,0.1130,      00159200
     3           2000.0,0.0734,0.0734,0.0782,0.0942,0.1270,0.1360,      00159300
     6           2300.0,0.0966,0.0966,0.1020,0.1160,0.1550,0.1670,      00159400
     7           2500.0,0.1160,0.1160,0.1230,0.1390,0.1790,0.1940,      00159500
     8           2800.0,0.1540,0.1540,0.1620,0.1800,0.2220,0.2420,      00159600
     9           3000.0,0.1900,0.1900,0.1960,0.2190,0.2620,0.2900 /     00159700
      DATA A08 /    0.0,                                                00159800
     1           -300.0, 0.070,-250.0, 0.070,-150.0, 0.105,             00159900
     2              0.0, 0.150, 250.0, 0.210, 500.0, 0.252,             00160000
     3            750.0, 0.275,1000.0, 0.288,1250.0, 0.296,             00160100
     4           1500.0, 0.300,1700.0, 0.302,1750.0, 0.303,             00160200
     5           2300.0, 0.303,        0.0,                             00160300
     1           -250.0, 0.425,-150.0, 0.450,   0.0, 0.487,             00160400
     2            250.0, 0.550, 500.0, 0.604, 750.0, 0.654,             00160500
     3           1000.0, 0.704,1250.0, 0.750,1500.0, 0.796,             00160600
     4           1700.0, 0.829,1750.0, 0.837,1950.0, 0.871,             00160700
     5           2000.0, 0.883,2100.0, 0.896,2150.0, 0.904,             00160800
     6           2300.0, 0.933,2500.0, 0.975,2800.0, 1.080,             00160900
     7           3000.0, 1.180,        0.0,                             00161000
     1           -250.0, 0.150,-150.0, 0.170,   0.0, 0.190,             00161100
     2            250.0, 0.215, 500.0, 0.240, 750.0, 0.260,             00161200
     3           1000.0, 0.285,1250.0, 0.300,1500.0, 0.315,             00161300
     4           1700.0, 0.325,1750.0, 0.330,1950.0, 0.340,             00161400
     5           2000.0, 0.345,2100.0, 0.350,2150.0, 0.353,             00161500
     6           2300.0, 0.360,2500.0, 0.375,2800.0, 0.390,             00161600
     7           3000.0, 0.390 /                                        00161700
      DATA A09 /    0.0,                                                00161800
     1           -400.0,   4.1,  68.0,   6.4, 600.0,   9.2,             00161900
     2            700.0,   9.7, 900.0,  10.9,1000.0,  11.5,             00162000
     3           1100.0,  11.8,1200.0,  12.2,1400.0,  13.3,             00162100
     4           1600.0,  14.4,2000.0,  16.2,                           00162200
     *              0.0, 2.784, 27.84, 278.4,2116.0,                    00162300
     1            100.0,.00566,.00666,0.0075,0.0100,0.0175,             00162400
     2            200.0,0.0065,0.0075,.00833,0.0108,0.0183,             00162500
     3            400.0,0.0073,.00833,.00917,.01167,.01917,             00162600
     4            600.0,0.0099,0.0100,.01083,.01333,.02083,             00162700
     5            800.0,0.0110,0.0125,0.0125,.01583,.02333,             00162800
     6           1000.0,0.0140,0.0150,.01583,.01833,.02583,             00162900
     7           1200.0,0.0170,.01833,.01917,.02167,.02917,             00163000
     *              0.0,                                                00163100
     1              0.0, 0.205, 200.0, 0.205, 400.0, 0.225,             00163200
     2            600.0, 0.240, 800.0, 0.252,1000.0, 0.261,             00163300
     3           1200.0, 0.269 /                                        00163400
      DATA A10 /  0.0,0.021, 0.212, 2.116, 21.16, 211.6,2116.0,         00163500
     1    -250.0,0.0065,0.0065,0.0070,0.0080,0.0092,0.0102,0.0110,      00163600
     2       0.0,0.0080,0.0080,0.0105,0.0140,0.0171,0.0198,0.0206,      00163700
     3     100.0,0.0086,0.0086,0.0120,0.0166,0.0205,0.0238,0.0250,      00163800
     4     200.0,0.0095,0.0095,0.0138,0.0194,0.0240,0.0275,0.0290,      00163900
     5     300.0,0.0102,0.0102,0.0155,0.0222,0.0275,0.0322,0.0335,      00164000
     6     400.0,0.0110,0.0110,0.0170,0.0250,0.0316,0.0370,0.0382,      00164100
     7     600.0,0.0130,0.0130,0.0207,0.0315,0.0407,0.0475,0.0489,      00164200
     8     800.0,0.0150,0.0150,0.0250,0.0380,0.0500,0.0608,0.0620,      00164300
     9    1000.0,0.0175,0.0175,0.0300,0.0462,0.0615,0.0775,0.0795,0.0,  00164400
     1           -250.0, 0.300,   0.0, 0.312, 200.0, 0.320,             00164500
     2       400.0, 0.335, 600.0, 0.345, 800.0, 0.360,1000.0,0.380,     00164600
     1       0.0,-200.0,  1.33,   0.0,  2.17, 200.0,  2.88,             00164700
     2            400.0,  3.46, 500.0,  3.64,1000.0,  4.21,             00164800
     3           1500.0,  4.42,2000.0,  4.46,2500.0,  4.42,             00164900
     4           2800.0,  4.42,                                         00165000
     1       0.0,-200.0,  2.33,   0.0,  3.96, 200.0,  5.25,             00165100
     2            400.0,  6.22, 500.0,  6.63,1000.0,  7.60,             00165200
     3           1500.0,  8.00,2000.0,  8.13,2500.0,  8.08,             00165300
     4           2800.0,  8.08 /                                        00165400
      DATA A11 /    0.0,                     -200.0,  0.12,             00165500
     1              0.0,  0.17, 200.0,  0.21, 400.0,  0.24,             00165600
     2            500.0,  0.26,1000.0,  0.31,1500.0,  0.34,             00165700
     3           2000.0,  0.37,2500.0,  0.40,2800.0,  0.41,             00165800
     *              0.0,                                                00165900
     1            200.0, 0.017, 500.0, 0.023, 800.0, 0.029,             00166000
     *              0.0,                                                00166100
     1            200.0, 0.025, 500.0, 0.034, 800.0, 0.043,             00166200
     *              0.0,                                                00166300
     1            200.0, 0.035, 500.0, 0.046, 800.0, 0.057,             00166400
     *              0.0,                                                00166500
     1             80.0,  0.19, 500.0,  0.21,1000.0,  0.23,             00166600
     2           2000.0,  0.26,3000.0,  0.28,                           00166700
     *              0.0,                                                00166800
     1              0.0,   5.2, 400.0,   7.2, 800.0,   9.2,             00166900
     2           1200.0,  11.2,1600.0,  13.2,2000.0,  15.1,             00167000
     3           2400.0,  17.0 /                                        00167100
      DATA A12 /    0.0,                                                00167200
     1            200.0, 0.070, 400.0, 0.084, 800.0, 0.114,             00167300
     2           1200.0, 0.144,1600.0, 0.174,2000.0, 0.203,             00167400
     3           2400.0, 0.232,        0.0,                             00167500
     1           -460.0, 0.0  ,-100.0, 0.013, 100.0, 0.013,             00167600
     2            200.0,0.0175,        0.0,                             00167700
     1           -352.0, 0.203,-280.0, 0.300,-234.0, 0.326,             00167800
     2           -190.0, 0.358,  80.0, 0.381,                           00167900
     *              0.0,0.2116, 2.116, 21.16, 211.6,2116.0,             00168000
     1           -250.0,0.0048,0.0048,0.0080,0.0098,0.0103,0.0107,      00168100
     2              0.0,0.0053,0.0053,0.0110,0.0178,0.0198,0.0205,      00168200
     3            100.0,0.0057,0.0057,0.0124,0.0208,0.0235,0.0244,      00168300
     4            200.0,0.0063,0.0063,0.0135,0.0240,0.0273,0.0285,      00168400
     5            300.0,0.0073,0.0073,0.0152,0.0272,0.0318,0.0330,      00168500
     6            400.0,0.0091,0.0091,0.0168,0.0303,0.0371,0.0382,      00168600
     7            600.0,0.0120,0.0120,0.0205,0.0390,0.0480,0.0493,      00168700
     8            800.0,0.0156,0.0156,0.0250,0.0500,0.0608,0.0620,      00168800
     9           1000.0,0.0205,0.0205,0.0310,0.0620,0.0730,0.0750,      00168900
     1     0.0,     0.0,   7.1, 400.0,   9.3, 800.0,  11.8,             00169000
     2           1200.0,  14.3,1400.0,  15.6 /                          00169100
      DATA A13 / 0.0278,0.2784, 2.784, 27.84, 278.4,2116.2,             00169200
     1           -200.0,0.0025,0.0050,0.0092,0.0100,0.0108,0.0108,      00169300
     2              0.0,0.0033,0.0058,0.0125,0.0158,0.0167,0.0167,      00169400
     3            200.0,0.0042,0.0067,0.0158,0.0217,0.0225,0.0225,      00169500
     4            400.0,0.0075,0.0092,0.0200,0.0283,0.0300,0.0300,      00169600
     5            600.0,0.0125,0.0150,0.0258,0.0375,0.0392,0.0400,      00169700
     6            800.0,0.0217,0.0233,0.0358,0.0492,0.0525,0.0525,      00169800
     7           1000.0,0.0350,0.0375,0.0500,0.0658,0.0692,0.0700,      00169900
     8           1200.0,0.0550,0.0567,0.0700,0.0875,0.0925,0.0925,      00170000
     9           1400.0,0.0825,0.0842,0.0975,0.1175,0.1225,0.1233,      00170100
     *           1600.0,0.1183,0.1200,0.1333,0.1550,0.1617,0.1625,      00170200
     1           1800.0,0.1650,0.1667,0.1800,0.2042,0.2108,0.2117,      00170300
     2           2000.0,0.2233,0.2250,0.1883,0.2642,0.2717,0.2683,      00170400
     *              0.0,                                                00170500
     1            153.0, 0.200, 300.0, 0.224, 500.0, 0.237,             00170600
     2            700.0, 0.247,1000.0, 0.257,1200.0, 0.262,             00170700
     3           1400.0, 0.267,1600.0, 0.271,1800.0, 0.274,             00170800
     4           2000.0, 0.277 /                                        00170900
      DATA A14 / 0.0278,  1.39,2116.2,                                  00171000
     1           -200.0,0.0007,0.0050,0.0093,                           00171100
     2            -50.0,0.0011,0.0059,0.0146,                           00171200
     3            100.0,0.0015,0.0065,0.0195,                           00171300
     4            250.0,0.0044,0.0094,0.0255,                           00171400
     5            400.0,0.0078,0.0128,0.0320,                           00171500
     *              0.0,                                                00171600
     1           -135.0,  0.17, -47.0,  0.18,   8.0,  0.20,             00171700
     2             81.0,  0.22, 153.0,  0.24, 225.0,  0.25,             00171800
     3            297.0,  0.26, 351.0,  0.27,                           00171900
     *           .00278, 0.278,  1.39,  2.78,  13.9,  27.8,2116.2,      00172000
     1           -210.0,0.0004,0.0022,0.0043,0.0053,0.0075,0.0082,      00172100
     2    0.0094,-200.0,0.0004,0.0022,0.0043,0.0053,0.0075,0.0082,      00172200
     3    0.0094, -50.0,0.0007,0.0023,0.0047,0.0063,0.0103,0.0123,      00172300
     4    0.0143, 100.0,0.0015,0.0029,0.0053,0.0076,0.0137,0.0163,      00172400
     5    0.0195, 250.0,0.0026,0.0040,0.0068,0.0092,0.0177,0.0204,      00172500
     6    0.0244, 400.0,0.0048,0.0065,0.0093,0.0120,0.0209,0.0244,      00172600
     7    0.0297                                                  /     00172700
      DATA A15 /    0.0,                                                00172800
     1           -400.0,   1.2,-200.0,   3.4,   0.0,   4.0,             00172900
     2            200.0,   4.3, 400.0,   5.0, 600.0,   6.0,             00173000
     3            800.0,   6.9,1000.0,   7.9,1200.0,   8.6,             00173100
     4           1400.0,   9.6,1600.0,  10.4,                           00173200
     *              0.0,                                                00173300
     1           -400.0, 0.012,-200.0, 0.096,   0.0, 0.125,             00173400
     2            200.0, 0.136, 400.0, 0.138, 600.0, 0.144,             00173500
     3            800.0, 0.153,1000.0, 0.167,1200.0, 0.182,             00173600
     4           1400.0, 0.205,1600.0, 0.225,                           00173700
     *              0.0,                                                00173800
     1           -451.0, 0.179,-415.0,  1.44,-280.0,  5.30,             00173900
     2           -190.0,  6.40,-100.0,  7.30,   0.0,  7.70,             00174000
     3            400.0,  9.40,1260.0, 13.10,1320.0, 13.40,             00174100
     4           2200.0, 17.00,2600.0, 18.40,                           00174200
     *              0.0,                                                00174300
     1              0.0, 0.110, 400.0, 0.110,1260.0, 0.219,             00174400
     2           1320.0, 0.132,2200.0, 0.176 /                          00174500
      DATA A16 / 0.0278,0.2784, 2.784, 27.84, 278.4,2116.2,             00174600
     1           -200.0,0.0050,0.0058,0.0100,0.0125,0.0133,0.0133,      00174700
     2              0.0,0.0050,0.0058,0.0117,0.0175,0.0192,0.0192,      00174800
     3            200.0,0.0058,0.0067,0.0125,0.0225,0.0250,0.0258,      00174900
     4            400.0,0.0075,0.0083,0.0142,0.0275,0.0317,0.0317,      00175000
     5            600.0,0.0108,0.0117,0.0175,0.0333,0.0392,0.0400,      00175100
     6            800.0,0.0167,0.0175,0.0233,0.0408,0.0483,0.0492,      00175200
     7           1000.0,0.0258,0.0258,0.0325,0.0508,0.0608,0.0617,      00175300
     8           1200.0,0.0383,0.0392,0.0458,0.0658,0.0767,0.0783,      00175400
     9           1400.0,0.0567,0.0575,0.0633,0.0850,0.0983,0.1000,      00175500
     *           1600.0,0.0817,0.0825,0.0883,0.1108,0.1258,0.1275,      00175600
     1           1800.0,0.1142,0.1142,0.1200,0.1433,0.1600,0.1625,      00175700
     2           2000.0,0.1542,0.1550,0.1608,0.1850,0.2033,0.2067,      00175800
     3           2200.0,0.2050,0.2058,0.2117,0.2358,0.2558,0.2592,      00175801
     4           2400.0,0.2667,0.2675,0.2725,0.2983,0.3200,0.3233 /     00175802
      DATA A17 / 0.0278,0.2784, 2.784, 27.84, 278.4,2116.2,             00175900
     1           -200.0,0.0100,0.0108,0.0133,0.0183,0.0192,0.0192,      00176000
     2              0.0,0.0100,0.0108,0.0142,0.0225,0.0258,0.0258,      00176100
     3            200.0,0.0108,0.0108,0.0150,0.0258,0.0317,0.0317,      00176200
     4            400.0,0.0117,0.0117,0.0158,0.0292,0.0367,0.0383,      00176300
     5            600.0,0.0133,0.0133,0.0175,0.0325,0.0433,0.0442,      00176400
     6            800.0,0.0158,0.0167,0.0200,0.0367,0.0500,0.0517,      00176500
     7           1000.0,0.0208,0.0208,0.0250,0.0425,0.0575,0.0600,      00176600
     8           1200.0,0.0275,0.0275,0.0317,0.0500,0.0675,0.0708,      00176700
     9           1400.0,0.0367,0.0375,0.0408,0.0600,0.0800,0.0842,      00176800
     *           1600.0,0.0492,0.0500,0.0533,0.0725,0.0950,0.1000,      00176900
     1           1800.0,0.0658,0.0667,0.0700,0.0900,0.1142,0.1200,      00177000
     2           2000.0,0.0875,0.0875,0.0908,0.1108,0.1375,0.1442,      00177100
     3           2200.0,0.1133,0.1142,0.1175,0.1375,0.1658,0.1733,      00177101
     4           2400.0,0.1458,0.1458,0.1492,0.1700,0.2000,0.2075 /     00177102
      DATA A18 /    0.0,                                                00177200
     1           -400.0, 0.110,   0.0, 0.115,                           00177300
     2            400.0, 0.130, 800.0, 0.150,                           00177301
     3           1200.0, 0.165,1600.0, 0.200,                           00177400
     4           2000.0, 0.255,2400.0, 0.370,                           00177500
     5           2800.0, 0.570, 4*0.0,                                  00177600
     *              0.0,                                                00177800
     1           -400.0, 0.450,   0.0, 0.500,                           00177900
     2            400.0, 0.560, 800.0, 0.640,                           00178000
     3           1200.0, 0.750,1600.0, 0.910,                           00178100
     4           2000.0, 1.150,2400.0, 1.480,                           00178200
     5           2800.0, 1.900, 4*0.0,                                  00178300
     1 0.0,       -60.0,0.1475, -50.0,0.1475,   0.0,0.1520,             00178700
     2            100.0,0.1750, 200.0,0.2170, 300.0,0.2520,             00178800
     3            400.0,0.2770, 500.0,0.2875, 600.0,0.2890,             00178900
     4            700.0,0.2980 /                                        00179000
      DATA A19 /    0.0,                                                00179100
     1            -60.0,0.0660, -50.0,0.0660,   0.0,0.0760,             00179200
     2            100.0,0.0975, 200.0,0.1140, 300.0,0.1280,             00179300
     3            400.0,0.1380, 500.0,0.1430, 600.0,0.1370,             00179400
     4            700.0,0.1270,                                         00179500
     *              0.0,                                                00179600
     1             50.0, 0.240, 100.0, 0.260, 150.0, 0.268,             00179700
     2            200.0, 0.275, 250.0, 0.278, 300.0, 0.279,             00179800
     3            350.0, 0.279,                                         00179900
     *              0.0,                                                00180000
     1            200.0, 0.036, 400.0, 0.044, 600.0, 0.053,             00180100
     2            800.0, 0.062,1000.0, 0.071,1200.0, 0.083,             00180200
     3           1400.0, 0.097,1600.0, 0.114,1800.0, 0.135,             00180300
     4           2000.0, 0.158,                                         00180400
     *              0.0,                                                00180500
     1            400.0, 0.202, 500.0, 0.214, 600.0, 0.223,             00180600
     2            700.0, 0.230, 800.0, 0.236,1000.0, 0.244,             00180700
     3           1200.0, 0.251,1400.0, 0.256,1600.0, 0.261,             00180800
     4           1800.0, 0.266,2000.0, 0.270,2200.0, 0.275 /            00180900
      DATA A20 /    0.0,                                                00181000
     1           -200.0, 0.233,-100.0, 0.250,   0.0, 0.245,             00181100
     2            200.0, 0.200, 400.0, 0.163, 500.0, 0.146,             00181200
     *              0.0,                                                00181300
     1           -140.0, 0.273,-100.0, 0.270, -50.0, 0.260,             00181400
     2              0.0, 0.265, 100.0, 0.285, 200.0, 0.300,             00181500
     3            400.0, 0.340,                                         00181600
     *              0.0,                                                00181700
     1           -420.0,  13.0,-350.0,  31.0,-300.0,  39.0,             00181800
     2           -200.0,  52.5,-100.0,  61.5,   0.0,  69.0,             00181900
     3            100.0,  74.0, 200.0,  78.0, 300.0,  82.0,             00182000
     4            400.0,  84.7, 500.0,  87.0, 600.0,  89.4,             00182100
     5            800.0,  92.0,                                         00182200
     *              0.0,                                                00182300
     1             75.0, 0.206, 200.0, 0.215, 300.0, 0.222,             00182400
     2            400.0, 0.228, 500.0, 0.234 /                          00182500
      DATA A21 /    0.0,                                                00182600
     1           -200.0,   5.9,   0.0,   6.5, 100.0,   7.0,             00182700
     2            200.0,   7.4, 400.0,   8.3, 600.0,   9.2,             00182800
     3            800.0,  10.1,1000.0,  11.1,1200.0,  11.9,             00182900
     4           1400.0,  12.8,1600.0,  13.6,1800.0,  14.4,             00183000
     *              0.0,                                                00183100
     1           -300.0, 0.070,-200.0, 0.081,-100.0, 0.092,   0.0,      00183200
     2      0.100,100.0, 0.105, 200.0, 0.110, 400.0, 0.116,             00183300
     3            600.0, 0.121, 800.0, 0.125,1000.0, 0.130,             00183400
     4           1200.0, 0.139,1400.0, 0.150,1600.0, 0.170,             00183500
     5           1800.0, 0.196,                                         00183600
     *              0.0,                                                00183700
     1           -200.0,  0.55, 400.0,  0.95, 800.0,  1.15,             00183800
     2           1200.0,  1.43,1600.0,  3.55,2000.0,  3.55,             00183900
     *              0.0,                                                00184000
     1           -200.0, 0.103, 400.0, 0.230, 800.0, 0.261,             00184100
     2           1500.0, 0.285,2000.0, 0.285 /                          00184200
      DATA A22 /    0.0,                                                00184300
     1              0.0, 0.155, 200.0, 0.210, 400.0, 0.265,             00184400
     2            500.0, 0.280, 600.0, 0.300,                           00184500
     *              0.0,                                                00184600
     1              0.0, 0.105, 200.0, 0.136, 400.0, 0.155,             00184700
     2            500.0, 0.162,                                         00184800
     *              0.0,                                                00184900
     1            200.0, 230.0, 600.0, 195.0,1000.0, 170.0,             00185000
     2           1400.0, 145.0,1500.0, 140.0,                           00185100
     *              0.0,                                                00185200
     1            200.0,   1.0, 600.0,  0.89,1000.0,  0.80,             00185300
     2           1400.0,  0.77,1500.0,  0.75  /                         00185400
      DATA A23 /   0.2116,  2.116, 21.16,211.62,2116.2,                 00185500
     1           -250.0, 0.011, 0.013, 0.022, 0.026, 0.030,             00185600
     2              0.0, 0.015, 0.018, 0.028, 0.033, 0.039,             00185700
     3            250.0, 0.020, 0.023, 0.033, 0.041, 0.047,             00185800
     4            500.0, 0.026, 0.030, 0.042, 0.051, 0.057,             00185900
     5            750.0, 0.035, 0.040, 0.051, 0.064, 0.070,             00186000
     6           1000.0, 0.049, 0.052, 0.063, 0.081, 0.088,             00186100
     7           1250.0, 0.066, 0.071, 0.083, 0.104, 0.111,             00186200
     8           1500.0, 0.089, 0.096, 0.109, 0.132, 0.140,             00186300
     9           1750.0, 0.119, 0.125, 0.140, 0.167, 0.175,             00186400
     *           2000.0, 0.153, 0.162, 0.180, 0.212, 0.221,             00186500
     1           2300.0, 0.213, 0.221, 0.240, 0.273, 0.288,             00186600
     *              0.0,                                                00186700
     1            200.0,   9.9, 600.0,   8.4,1000.0,   7.3,             00186800
     2           1400.0,   6.7,1800.0,   6.1,                           00186900
     *              0.0,                                                00187000
     1            100.0, 0.021, 500.0, 0.033,1000.0, 0.056,             00187100
     2           1500.0, 0.098,2000.0, 0.158 /                          00187200
      DATA A24 /    0.0,                                                00187300
     1           -200.0,  65.0,-100.0,  80.0,   0.0,  99.0,             00187400
     2            200.0,  98.0, 400.0,  82.0, 600.0,  75.0,             00187500
     3            800.0,  68.0,1200.0,  59.0,1600.0,  51.0,             00187600
     4           2000.0,  49.0,2400.0,  36.0,                           00187700
     *              0.0,                                                00187800
     1           -400.0,0.0014,-250.0,  0.06,-200.0,  0.12,             00187900
     2           -100.0,  0.28,   0.0,  0.40, 200.0,  0.50,             00188000
     3            400.0,  0.56, 600.0,  0.61, 800.0,  0.65,             00188100
     4           1200.0,  0.70,1600.0,  0.75,2000.0,  0.81,             00188200
     5           2400.0,  0.86,                                         00188300
     *              0.0,                                                00188400
     1           -200.0, 244.0,   0.0, 231.0, 200.0, 224.0,             00188500
     2            400.0, 222.0, 600.0, 218.0, 800.0, 215.0,             00188600
     3           1000.0, 210.0,1200.0, 209.0,1400.0, 200.0,             00188700
     4           1600.0, 196.0 /                                        00188800
      DATA A25 /    0.0,                                                00188900
     1           -400.0, 0.008,-300.0, 0.036,-200.0, 0.073,             00189000
     2              0.0, 0.092, 200.0, 0.093, 400.0, 0.097,             00189100
     3            600.0, 0.099, 800.0, 0.100,1000.0, 0.103,             00189200
     4           1200.0, 0.104,1400.0, 0.106,1600.0, 0.113,             00189300
     *              0.0,                                                00189400
     1            200.0,   5.6, 400.0,   6.5, 600.0,   7.5,             00189500
     2            800.0,   8.4,1000.0,   9.3,1200.0,  12.1,             00189600
     3           1400.0,  15.2,1600.0,  16.4,1800.0,  17.0,             00189700
     4           2000.0,  17.4,                                         00189800
     *              0.0,                                                00189900
     1             70.0, 0.092,1000.0, 0.122,1200.0, 0.129,             00190000
     2           1400.0, 0.137,1600.0, 0.145,1800.0, 0.152,             00190100
     3           2000.0, 0.160,2200.0, 0.167 /                          00190200
      DATA A26 /    0.0,                                                00190300
     1             70.0,   6.5, 200.0,   7.3, 400.0,   8.3,             00190400
     2            600.0,   9.4, 800.0,  10.5,1000.0,  11.6,             00190500
     3           1200.0,  12.8,1400.0,  13.8,1600.0,  14.8,             00190600
     4           1800.0,  15.8,2000.0,  16.9,                           00190700
     *              0.0,                                                00190800
     1             70.0, 0.107, 200.0, 0.112, 400.0, 0.119,             00190900
     2            600.0, 0.126, 800.0, 0.133,1000.0, 0.140,             00191000
     3           1200.0, 0.147,1400.0, 0.155,1600.0, 0.162,             00191100
     4           1800.0, 0.169,2000.0, 0.176,                           00191200
     *              0.0,                                                00191300
     1           -200.0, 252.0,-100.0, 248.0,   0.0, 246.0,             00191400
     2            200.0, 238.0, 400.0, 232.0, 600.0, 226.0,             00191500
     3            800.0, 222.0,1000.0, 222.0,1200.0, 220.0,             00191600
     *              0.0,                                                00191700
     1           -400.0, 0.014,-200.0, 0.051,   0.0, 0.056,             00191800
     2            200.0, 0.057, 400.0, 0.058, 600.0, 0.059,             00191900
     3            800.0, 0.061,1000.0, 0.062,1200.0, 0.064,             00192000
     4           1400.0, 0.066 /                                        00192100
      DATA A27 /    0.0,                                                00192101
     1            280.0, 0.025, 500.0, 0.033,1000.0, 0.064,             00192102
     2           1500.0, 0.121,2000.0, 0.217,                           00192103
     *              0.0,                                                00192104
     1           -200.0,   7.0,   0.0,   8.3,  70.0,   8.7,             00192105
     2            200.0,   9.3, 400.0,  10.0, 600.0,  11.1,             00192106
     3            800.0,  12.1,1000.0,  13.4,1200.0,  14.4,             00192107
     4           1400.0,  15.5,1500.0,  16.1,1600.0,  16.7,             00192108
     *              0.0,                                                00192109
     1           -200.0, 0.080,   0.0, 0.099, 400.0, 0.116,             00192110
     2            800.0, 0.127,1200.0, 0.139,1600.0, 0.149,             00192111
     *              0.0,                                                00192112
     1           -200.0,   4.2,   0.0,   5.2,  70.0,   5.7,             00192113
     2            400.0,   7.2, 800.0,   9.0,1200.0,  11.1,             00192114
     3           1500.0,  12.6,1600.0,  13.1,1800.0,  14.6,             00192115
     *              0.0,                                                00192116
     1              0.0, 0.096, 400.0, 0.109, 800.0, 0.122,             00192117
     2           1200.0, 0.135,1600.0, 0.148,2000.0, 0.160 /            00192118
      DATA A28 /    0.0,                                                00192119
     1           -450.0,   0.2,-420.0,   1.4,-300.0,   5.1,             00192120
     2           -100.0,   7.4,   0.0,   8.0,  75.0,   8.5,             00192121
     3            200.0,   9.4, 400.0,  10.5, 600.0,  11.4,             00192122
     4            800.0,  12.3,1000.0,  13.2,                           00192123
     *              0.0,                                                00192124
     1              0.0, 0.130,  75.0, 0.135, 800.0, 0.135,             00192125
     2           1000.0, 0.138,1200.0, 0.140,1400.0, 0.142,             00192126
     3           1600.0, 0.145,1800.0, 0.147,                           00192127
     *              0.0,                                                00192128
     1              0.0,  14.0,  75.0,  14.5, 100.0,  14.7,             00192129
     2            200.0,  15.0, 300.0,  15.3, 400.0,  15.6,             00192130
     3            500.0,  15.9, 600.0,  16.2, 700.0,  16.5,             00192131
     4            800.0,  16.8,                                         00192132
     *              0.0,                                                00192133
     1              0.0, 0.102,  75.0, 0.108, 100.0, 0.110,             00192134
     2            200.0, 0.116, 300.0, 0.122, 400.0, 0.126,             00192135
     3            500.0, 0.131, 600.0, 0.137, 700.0, 0.146,             00192136
     4            800.0, 0.154,1000.0, 0.171,1200.0, 0.196,             00192137
     5 1400.0,    0.205,1600.0, 0.185,1800.0, 0.181,2000.0, 0.163 /     00192138
      DATA A29 / 0.0278,0.2784, 2.784, 27.84, 278.4,2116.2,             00192139
     1           -200.0,0.0033,0.0050,0.0092,0.0108,0.0117,0.0117,      00192140
     2              0.0,0.0042,0.0050,0.0108,0.0167,0.0175,0.0175,      00192141
     3            200.0,0.0050,0.0058,0.0133,0.0217,0.0233,0.0233,      00192142
     4            400.0,0.0075,0.0083,0.0158,0.0275,0.0308,0.0308,      00192143
     5            600.0,0.0117,0.0133,0.0208,0.0350,0.0392,0.0400,      00192144
     6            800.0,0.0200,0.0217,0.0292,0.0458,0.0517,0.0517,      00192145
     7           1000.0,0.0333,0.0342,0.0425,0.0608,0.0683,0.0692,      00192146
     8           1200.0,0.0525,0.0533,0.0617,0.0817,0.0900,0.0917,      00192147
     9           1400.0,0.0792,0.0800,0.0883,0.1100,0.1200,0.1217,      00192148
     *           1600.0,0.1150,0.1158,0.1242,0.1475,0.1583,0.1600,      00192149
     1           1800.0,0.1617,0.1625,0.1708,0.1950,0.2075,0.2092,      00192150
     2           2000.0,0.2208,0.2217,0.2292,0.2550,0.2692,0.2708,      00192151
     3           2200.0,0.2933,0.2942,0.3017,0.3283,0.3442,0.3467,      00192152
     4           2400.0,0.3817,0.3825,0.3908,0.4183,0.4350,0.4375 /     00192153
      DATA A30 /    0.0,                                                00192154
     1           -300.0,  3.84,   0.0,  5.88, 200.0,  7.32,             00192155
     2            400.0,  8.64, 600.0,  9.96, 800.0, 11.16,             00192156
     *              0.0,                                                00192157
     1           -200.0,   6.4,   0.0,   7.4, 400.0,   9.2,             00192158
     2            800.0,  11.1,1200.0,  12.8,1600.0,  14.4,             00192159
     *              0.0,                                                00192160
     1           -250.0, 0.080,   0.0, 0.105, 200.0, 0.118,             00192161
     2            400.0, 0.126, 800.0, 0.135,1200.0, 0.140,             00192162
     3           1600.0, 0.156,                                         00192163
     *              0.0,                                                00192164
     1           -300.0,   4.3,-100.0,   6.2,   0.0,   6.9,             00192165
     2            400.0,   9.4, 800.0,  11.8,1200.0,  14.4,             00192166
     3           1600.0,  16.8 /                                        00192167
C                                                                       00192200
 1000 IPDA=0                                                            00192300
      ID=LOC(IDEX)                                                      00192400
      IF (ID.GT.0) GO TO 1010                                           00192500
      IPDA=1                                                            00192600
      GO TO 1090                                                        00192700
 1010 NTBS=IBSTG(1)+1                                                   00192800
      LD=IBSTG(2)                                                       00192900
      DO 1020 I=1,14                                                    00193000
 1020 TBID(I,NTBS)=TLE(I,IDEX)                                          00193100
      NE=INE(IDEX)                                                      00193200
      NC=INC(IDEX)                                                      00193300
      NC1=NC+1                                                          00193400
      LDO=LD+6                                                          00193500
      IDO=ID-1                                                          00193600
      DO 1030 I=1,NC                                                    00193700
 1030 TBSTG(LDO+I)=ARY(IDO+I)                                           00193800
      NLD=NE*NC1                                                        00193900
      LDO=LD+13                                                         00194000
      IDO=IDO+NC                                                        00194100
      DO 1040 I=1,NLD                                                   00194200
 1040 TBSTG(LDO+I)=ARY(IDO+I)                                           00194300
 1090 RETURN                                                            00194400
      END                                                               00194500
*DECK COND                                                              00194501
C     SUBROUTINE COND OF PROGRAM XF0031                                 00194600
C     L.W. FESLER     41-383/530  X4263                                 00194700
C                                                                       00194800
C                *****      *****      *****      *****                 00194900
C                                                                       00195000
C     THIS SUBROUTINE COMPUTES THE CONDUCTANCE OF EACH SECTION.         00195100
C                                                                       00195200
C                *****      *****      *****      *****                 00195300
C                                                                       00195400
      SUBROUTINE COND                                                   00195500
C                                                                       00195600
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00195700
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00195800
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00195900
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00196000
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00196100
     5              ICLOCK,IDOMT,INPP(33)                               00196101
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00196200
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00196300
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00196400
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00196500
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00196600
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00196700
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00196800
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00196900
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00197000
     2              DGP2(75),PGSF(75),BQGP(75),                         00197100
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00197200
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00197300
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00197400
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00197500
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL,            00197600
     3              IMET(300),ICOET(8,300)                              00197700
      COMMON /CMNC/ TKXYZ(3,300),IMDB(20),ITKK(20),IDBLE,ISET           00197800
C                                                                       00197900
C     INITIALIZE                                                        00198000
 1000 IF (ICOND.GE.0) GO TO 2000                                        00198100
      ICOND=0                                                           00198200
      IDBLE=0                                                           00198300
      ISET=0                                                            00198400
      DO 1005 I=1,NMTLO                                                 00198500
      IMX=NMTL(I)+100                                                   00198600
      IMDB(I)=LONP(IMX,NMTLO,NMTL)                                      00198700
      IF (IMDB(I).NE.0) IDBLE=1                                         00198800
      ITKK(I)=1                                                         00198900
      IF (TKY(I).NE.0.0.AND.TKY(I).NE.TKX(I)) ITKK(I)=2                 00199000
      IF (TKZ(I).NE.0.0.AND.TKZ(I).NE.TKY(I)) ITKK(I)=3                 00199100
      IF (NMTL(I).GE.1000) ITKK(I)=3                                    00199200
 1005 CONTINUE                                                          00199300
      DO 1010 I=1,NSCTO                                                 00199400
      TKXYZ(1,I)=0.0                                                    00199500
      TKXYZ(2,I)=0.0                                                    00199600
      TKXYZ(3,I)=0.0                                                    00199700
      DO 1010 J=1,8                                                     00199800
      ICOET(J,I)=0                                                      00199900
 1010 COET(J,I)=0.0                                                     00200000
      DO 1390 I=1,NSCTO                                                 00200100
      JN=IOSC(9,I)                                                      00200200
      IF (JN.EQ.0) GO TO 1390                                           00200300
      ISII=NSCT(I)                                                      00200400
      DO 1380 J=1,JN                                                    00200500
      IF (COET(J,I).NE.0.0) GO TO 1380                                  00200600
      ISCT=NOSC(J,I)                                                    00200700
      IS=IOSC(J,I)                                                      00200800
      JSII=NSCT(IS)                                                     00200900
 1020 ICCT=0                                                            00201000
      IF (NCCTO.EQ.0) GO TO 1030                                        00201100
      ICCT=LOAP(ISII,JSII,NCCTO,NCCI,NCCJ)                              00201200
      IF (ICCT.EQ.0) ICCT=LOAP(JSII,ISII,NCCTO,NCCI,NCCJ)               00201300
 1030 IGAP=0                                                            00201400
      IF (NGAPO.EQ.0) GO TO 1040                                        00201500
      IGAP=LOAP(ISII,JSII,NGAPO,NGPI,NGPJ)                              00201600
      IF (IGAP.EQ.0) IGAP=LOAP(JSII,ISII,NGAPO,NGPI,NGPJ)               00201700
 1040 IF (ICCT.EQ.0.AND.IGAP.EQ.0) GO TO 1100                           00201800
      ICOET(J,I)=10000+100*IGAP+ICCT                                    00201900
      IF (IGAP.NE.0) GO TO 1200                                         00202000
 1100 IDUM=0                                                            00202100
      IMT1=IMET(I)                                                      00202200
      IM1X=IMT1                                                         00202300
      IF (IDBLE.EQ.0) GO TO 1103                                        00202400
      IMX1=IMDB(IMT1)                                                   00202500
      IF (IMX1.LE.0) GO TO 1103                                         00202600
      IF (TIMEC.GE.RHO(IMX1)) IM1X=IMX1                                 00202700
 1103 PRES1=TBLP(PMSF(IM1X),TIMEC,0.0,IDMM)                             00202800
      IMT2=IMET(IS)                                                     00202900
      IM2X=IMT2                                                         00203000
      IF (IDBLE.EQ.0) GO TO 1106                                        00203100
      IMX2=IMDB(IMT2)                                                   00203200
      IF (IMX2.LE.0) GO TO 1106                                         00203300
      IF (TIMEC.GE.RHO(IMX2)) IM2X=IMX2                                 00203400
 1106 PRES2=TBLP(PMSF(IM2X),TIMEC,0.0,IDMM)                             00203500
      IF (ISCT.GT.20000) GO TO 1110                                     00203600
      DD1=DX(I)                                                         00203700
      DD2=DX(IS)                                                        00203800
      TK1=TBLP(TKX(IMT1),TL(I),PRES1,IDUM)                              00203900
      IF (NMTL(IMT1).GE.1000)                                           00204000
     1TK1=TK1*TBLP(BCDM(8,IMT1),TL(I),PRES1,IDUM)                       00204100
      TK2=TBLP(TKX(IMT2),TL(IS),PRES2,IDUM)                             00204200
      IF (NMTL(IMT2).GE.1000)                                           00204300
     1TK2=TK2*TBLP(BCDM(8,IMT2),TL(IS),PRES2,IDUM)                      00204400
      GO TO 1130                                                        00204500
 1110 IF (ISCT.GT.30000) GO TO 1120                                     00204600
      DD1=DY(I)                                                         00204700
      DD2=DY(IS)                                                        00204800
      TK1=TBLP(TKY(IMT1),TL(I),PRES1,IDUM)                              00204900
      IF (NMTL(IMT1).GE.1000)                                           00205000
     1TK1=TK1*TBLP(BCDM(8,IMT1),TL(I),PRES1,IDUM)                       00205100
      TK2=TBLP(TKY(IMT2),TL(IS),PRES2,IDUM)                             00205200
      IF (NMTL(IMT2).GE.1000)                                           00205300
     1TK2=TK2*TBLP(BCDM(8,IMT2),TL(IS),PRES2,IDUM)                      00205400
      GO TO 1130                                                        00205500
 1120 DD1=DZ(I)                                                         00205600
      DD2=DZ(IS)                                                        00205700
      TK1=TBLP(TKZ(IMT1),TL(I),PRES1,IDUM)                              00205800
      IF (NMTL(IMT1).GE.1000)                                           00205900
     1TK1=TK1*TBLP(BCDM(8,IMT1),TL(I),PRES1,IDUM)                       00206000
      TK2=TBLP(TKZ(IMT2),TL(IS),PRES2,IDUM)                             00206100
      IF (NMTL(IMT2).GE.1000)                                           00206200
     1TK2=TK2*TBLP(BCDM(8,IMT2),TL(IS),PRES2,IDUM)                      00206300
 1130 IF (DD1.LT.0.0) DD1=-2.0*DD1                                      00206400
      IF (DD2.LT.0.0) DD2=-2.0*DD2                                      00206500
      TERM=DD1*TK2+DD2*TK1                                              00206600
      IF (ICCT.NE.0) TERM=TERM+24.0*TK1*TK2/CCT(ICCT)                   00206700
      COTO=TERM                                                         00206800
      IF (ABS(COTO).GT.1.0E-30) COTO=TK1*TK2/COTO                       00206900
      IF (IDUM.EQ.0) ICOET(J,I)=1                                       00207000
      IF (IDUM.NE.0.AND.ICCT.EQ.0) ICOET(J,I)=2                         00207100
      GO TO 1300                                                        00207200
 1200 IDUM=0                                                            00207300
      TPAVG=(TL(I)+TL(IS))/2.0                                          00207400
      PREST=PGSF(IGAP)                                                  00207500
      IF (IDBLE.EQ.0) GO TO 1205                                        00207600
      IMI=IMET(I)                                                       00207700
      IF (IMDB(IMI).EQ.0) IMI=IMET(IS)                                  00207800
      IMM=IMDB(IMI)                                                     00207900
      IF (IMM.EQ.0) GO TO 1205                                          00208000
      IF (PREST.NE.PMSF(IMI)) GO TO 1205                                00208100
      IF (TIMEC.GE.RHO(IMM)) PREST=PMSF(IMM)                            00208200
 1205 PRES=TBLP(PREST,TIMEC,0.0,IDMM)                                   00208300
      CTK=TBLP(TKC(IGAP),TPAVG,PRES,IDUM)                               00208400
      GTK=TBLP(TKG(IGAP),TPAVG,PRES,IDUM)                               00208500
      COTO=GPAR(IGAP)*(CTK-GTK)+GTK                                     00208600
      TERM=GPL(IGAP)                                                    00208700
      IF (ICCT.NE.0) TERM=TERM+24.0*COTO/CCT(ICCT)                      00208800
      COTO=0.5*COTO/TERM                                                00208900
      IF (IDUM.EQ.0) ICOET(J,I)=1                                       00209000
 1300 COET(J,I)=COTO*BCOET(J,I)                                         00209100
      IF (ICOET(J,I).GT.1) ICOND=1                                      00209200
      DO 1310 JS=1,8                                                    00209300
      IF (IOSC(JS,IS).EQ.I) GO TO 1320                                  00209400
 1310 CONTINUE                                                          00209500
      GO TO 1390                                                        00209600
 1320 IF (COET(JS,IS).NE.0.0) GO TO 1380                                00209700
      COET(JS,IS)=COET(J,I)                                             00209800
      ICOET(JS,IS)=ICOET(J,I)                                           00209900
 1380 CONTINUE                                                          00210000
 1390 CONTINUE                                                          00210100
      GO TO 9000                                                        00210200
C                                                                       00210300
C     CONDUCTANCE                                                       00210400
 2000 IF (ICOND.EQ.0) GO TO 9000                                        00210500
      CALL CODD                                                         00210600
C                                                                       00210700
C     EXIT                                                              00210800
 9000 RETURN                                                            00210900
      END                                                               00211000
*DECK CODD                                                              00211001
C     SUBROUTINE CODD OF PROGRAM XF0031                                 00211100
C     L.W. FESLER     41-383/530  X4263                                 00211200
C                                                                       00211300
C                *****      *****      *****      *****                 00211400
C                                                                       00211500
C     THIS SUBROUTINE COMPUTES THE CONDUCTANCE OF EACH SECTION.         00211600
C                                                                       00211700
C                *****      *****      *****      *****                 00211800
C                                                                       00211900
      SUBROUTINE CODD                                                   00212000
C                                                                       00212100
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00212200
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00212300
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00212400
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00212500
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00212600
     5              ICLOCK,IDOMT,INPP(33)                               00212601
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00212700
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00212800
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00212900
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00213000
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00213100
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00213200
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00213300
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00213400
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00213500
     2              DGP2(75),PGSF(75),BQGP(75),                         00213600
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00213700
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00213800
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00213900
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00214000
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL,            00214100
     3              IMET(300),ICOET(8,300)                              00214200
      COMMON /CMNC/ TKXYZ(3,300),IMDB(20),ITKK(20),IDBLE,ISET           00214300
 2000 IF (ICOND.EQ.0) GO TO 9000                                        00214400
      DO 2020 I=1,NSCTO                                                 00214500
      JN=IOSC(9,I)                                                      00214600
      IF (JN.EQ.0) GO TO 2020                                           00214700
      IMTL=IMET(I)                                                      00214800
      IMLT=NMTL(IMTL)                                                   00214900
      IMM=IMTL                                                          00215000
      IF (IDBLE.EQ.0) GO TO 2005                                        00215100
      IMX=IMDB(IMTL)                                                    00215200
      IF (IMX.LE.0) GO TO 2005                                          00215300
      IF (TIMEC.GE.RHO(IMX)) IMM=IMX                                    00215400
 2005 PRES=PMSF(IMM)                                                    00215500
      IF (PRES.LT.0.0) PRES=TBLP(PRES,TIMEC,0.0,IDUM)                   00215600
      IMY=ITKK(IMTL)                                                    00215700
      TKK=TBLP(TKX(IMTL),TL(I),PRES,IDUM)                               00215800
      IF (IMLT.GE.1000) TKK=TKK*TBLP(BCDM(8,IMTL),TL(I),PRES,IDUM)      00215900
      TYK=TKK                                                           00216000
      IF (TKK.EQ.0.0) GO TO 2006                                        00216100
      TKXYZ(1,I)=DX(I)/TKK                                              00216200
      IF (DX(I).LT.0.0) TKXYZ(1,I)=-2.0*TKXYZ(1,I)                      00216300
 2006 IF (IMY.GT.1) TYK=TBLP(TKY(IMTL),TL(I),PRES,IDUM)                 00216400
      IF (IMLT.GE.1000) TYK=TYK*TBLP(BCDM(8,IMTL),TL(I),PRES,IDUM)      00216500
      IF (TYK.EQ.0.0) GO TO 2007                                        00216600
      TKXYZ(2,I)=DY(I)/TYK                                              00216700
      IF (DY(I).LT.0.0) TKXYZ(2,I)=-2.0*TKXYZ(2,I)                      00216800
 2007 IF (IMY.GT.2) TKK=TBLP(TKZ(IMTL),TL(I),PRES,IDUM)                 00216900
      IF (IMLT.GE.1000) TKK=TKK*TBLP(BCDM(8,IMTL),TL(I),PRES,IDUM)      00217000
      IF (TKK.EQ.0.0) GO TO 2008                                        00217100
      TKXYZ(3,I)=DZ(I)/TKK                                              00217200
      IF (DZ(I).LT.0.0) TKXYZ(3,I)=-2.0*TKXYZ(3,I)                      00217300
 2008 DO 2010 J=1,JN                                                    00217400
      IF (ICOET(J,I).GT.1) COET(J,I)=0.0                                00217500
 2010 CONTINUE                                                          00217600
 2020 CONTINUE                                                          00217700
      DO 2390 I=1,NSCTO                                                 00217800
      JN=IOSC(9,I)                                                      00217900
      IF (JN.EQ.0) GO TO 2390                                           00218000
      DO 2380 J=1,JN                                                    00218100
      ICOT=ICOET(J,I)                                                   00218200
      IF (ICOT.LE.1) GO TO 2380                                         00218300
      IF (COET(J,I).NE.0.0) GO TO 2380                                  00218400
      ISCT=NOSC(J,I)/10000                                              00218500
      IS=IOSC(J,I)                                                      00218600
      ICCT=0                                                            00218700
      IGAP=0                                                            00218800
      IF (ICOT.LE.10000) GO TO 2100                                     00218900
      INBR=ICOT-10000                                                   00219000
      IGAP=INBR/100                                                     00219100
      ICCT=INBR-100*IGAP                                                00219200
      IF (IGAP.NE.0) GO TO 2200                                         00219300
 2100 COTO=TKXYZ(ISCT,I)+TKXYZ(ISCT,IS)                                 00219400
      IF (ICCT.NE.0) COTO=COTO+24.0/CCT(ICCT)                           00219500
      IF (COTO.EQ.0.0) GO TO 2305                                       00219600
      GO TO 2300                                                        00219700
 2200 TPAVG=(TL(I)+TL(IS))/2.0                                          00219800
      PREST=PGSF(IGAP)                                                  00219900
      IF (IDBLE.EQ.0) GO TO 2205                                        00220000
      IMI=IMET(I)                                                       00220100
      IF (IMDB(IMI).EQ.0) IMI=IMET(IS)                                  00220200
      IMM=IMDB(IMI)                                                     00220300
      IF (IMM.EQ.0) GO TO 2205                                          00220400
      IF (PREST.NE.PMSF(IMI)) GO TO 2205                                00220500
      IF (TIMEC.GE.RHO(IMM)) PREST=PMSF(IMM)                            00220600
 2205 PRES=TBLP(PREST,TIMEC,0.0,IDMM)                                   00220700
      CTK=TBLP(TKC(IGAP),TPAVG,PRES,IDUM)                               00220800
      GTK=TBLP(TKG(IGAP),TPAVG,PRES,IDUM)                               00220900
      COTO=GPAR(IGAP)*(CTK-GTK)+GTK                                     00221000
      TERM=GPL(IGAP)                                                    00221100
      IF (ICCT.NE.0) TERM=TERM+24.0*COTO/CCT(ICCT)                      00221200
      COET(J,I)=0.5*COTO*BCOET(J,I)/TERM                                00221300
      GO TO 2305                                                        00221400
 2300 COET(J,I)=BCOET(J,I)/COTO                                         00221500
 2305 DO 2310 JS=1,8                                                    00221600
      IF (IOSC(JS,IS).EQ.I) GO TO 2320                                  00221700
 2310 CONTINUE                                                          00221800
      GO TO 2390                                                        00221900
 2320 IF (COET(JS,IS).EQ.0.0) COET(JS,IS)=COET(J,I)                     00222000
 2380 CONTINUE                                                          00222100
 2390 CONTINUE                                                          00222200
C                                                                       00222300
C     EXIT                                                              00222400
 9000 RETURN                                                            00222500
      END                                                               00222600
*DECK INPT                                                              00222601
C     SUBROUTINE INPT OF PROGRAM XF0031                                 00222700
C     L.W. FESLER     41-383/530  X4263                                 00222800
C                                                                       00222900
C                *****      *****      *****      *****                 00223000
C                                                                       00223100
C     THIS SUBROUTINE READS THE INPUT DATA AND PRINTS THE               00223200
C     INPUT DATA.                                                       00223300
C                                                                       00223400
C                *****      *****      *****      *****                 00223500
C                                                                       00223600
      SUBROUTINE INPT                                                   00223700
C                                                                       00223800
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00223900
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00224000
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00224100
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00224200
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00224300
     5              ICLOCK,IDOMT,INPP(33)                               00224301
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00224400
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00224500
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00224600
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300),       00224700
     4              ICRDR,ICRDP,CORD(3,300)                             00224800
      COMMON /CMN3/ TBSTG(4000),TBID(14,99)                             00224900
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00225000
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00225100
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00225200
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00225300
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00225400
     2              DGP2(75),PGSF(75),BQGP(75),                         00225500
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00225600
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00225700
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00225800
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00225900
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00226000
     3              FP(75,3,2),BQA(75,3,2),                             00226100
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00226200
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00226300
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00226400
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00226500
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00226600
      COMMON /CMN7/ NRIO(3,2),NRI(25,3,2),ERI(25,3,2),DRI(25,3,2),      00226700
     1              ZRI(25,3,2),NAVT(2),BVT(40,40,2),NBVT(40,2),        00226800
     2              NVFO(2),NVFI(750,2),NVFJ(750,2),VFIJ(750,2),SFAS(2) 00226900
      COMMON /CMN9/ NCRTO(5),NCRT(11,50,5),NCSEO,NCSE(300),NCSSO,       00227000
     1              NCSS(99),NCPT(99),NHLDO,NHLD(300),NHRTO,NHRT(300),  00227100
     2              TENRY,TDOWN,YSCLE(2,5),IPCRT                        00227200
      COMMON /CMNS/ NSIZE,STEMP(10),SDRAT(10),STIME(10),ISIZE,TSZO,     00227300
     1              SIZET,DEGSZ,NODSZ,METSZ,IDRSZ,IPNSZ,ITRSZ,RDMIN     00227400
      COMMON /CMNP/ AAA(12)                                             00227401
      DIMENSION CM11(35),CM12(624),CM21(4299),CM22(1502),CM3(5386),     00227500
     1          CM4(602),CM5(1328),CM6(9088),CM7(8392),                 00227600
     2          CM91(2755),CM92(12)                                     00227700
      EQUIVALENCE (CM11(1),INPO(1)),(CM12(1),DELT),(CM21(1),NSCTL(1)),  00227800
     1            (CM22(1),PCQL(1)),(CM3(1),TBSTG(1)),(CM4(1),NMTLO),   00227900
     2            (CM5(1),NGAPO),(CM6(1),NAO(1,1)),(CM7(1),NRIO(1,1)),  00228000
     3            (CM91(1),NCRTO(1)),(CM92(1),TENRY)                    00228100
C                                                                       00228200
      DIMENSION DATA(20),INRR(36)                                       00228300
C                                                                       00228400
      REAL   DATA8(12),ENDM                                             00228500
      DATA ENDM / "ENDM" /                                              00228600
      DATA IBLK,BLK / 77777777777777777777B,77777777777777777777B /     00228700
      DATA CRDRT / "CORD" /                                             00228800
C                                                                       00228900
  100 FORMAT(1H15X,15A4)                                                00229000
  101 FORMAT(12A10)                                                     00229001
  105 FORMAT(1H 5X,"NCASE",I4///1H 5X,9X,"ISCT",6X,                     00229100
     1"IMTL",6X,"IGAP",6X,"IOFS",4X,"ICCT",3X,"IQAX1",3X,"IQAX2",       00229200
     23X,"IQAY1",3X,"IQAY2",3X,"IQAZ1",3X,"IQAZ2")                      00229300
  106 FORMAT(6(1H ),"1",113(1H ))                                       00229301
  110 FORMAT(1H05X,9X,"IRRX",6X,"IRRY",6X,"IRRZ",5X,"IRIX1",3X,         00229400
     1"IRIY1",3X,"IRIZ1",3X,"IRVF1",3X,"IRIX2",3X,"IRIY2",3X,           00229500
     2"IRIZ2",3X,"IRVF2")                                               00229600
  111 FORMAT(6(1H ),"2",113(1H ))                                       00229601
  120 FORMAT(1H05X,9X,"ICVX",6X,"ICVY",6X,"ICVZ",6X,"IKTP",4X,          00229700
     1"IPCM",4X,"ICRT",3X,"ICRT1",3X,"ICRT2",3X,"ICRT3",3X,             00229800
     2"ICRT4",3X,"ICRT5")                                               00229900
  121 FORMAT(6(1H ),"3",113(1H ))                                       00229901
  130 FORMAT(1H05X,9X,"DELT",5X,"DELTP",5X,"TIMEO",6X,"TEND",4X,        00230000
     1"IHRS",4X,"IPNT",4X,"ITST",4X,"FTRN",4X,"DMTX",4X,"TOLR",3X,      00230100
     2"RCMIN")                                                          00230200
  131 FORMAT(6(1H ),"4  ",4F10.3,24(1H ),3F8.2,23(1H ))                 00230201
  150 FORMAT(1H15X,"PREDATA MODIFICATION CARDS"/1H 5X,"NCASE",I4///     00230300
     11H 5X,"ICODE ",9X,"I1",6X,"I2",6X,"I3",6X,"I4",6X,"I5",6X,        00230400
     2"D1",6X,"D2",6X,"D3",6X,"D4",6X,"D5",6X,"D6")                     00230500
  160 FORMAT(12A6,2A4)                                                  00230600
  170 FORMAT(1H 5X,A6,3X,11(2X,A6))                                     00230700
  200 FORMAT(1H15X,"SECTION DATA"/1H 5X,"NCASE",I4///1H 5X,             00230800
     1"NSCTO=",I4//1H 5X,"NSCT",8X,"TO",2X,"MTLN",8X,"DX",8X,"DY",8X,   00230900
     2"DZ",3X,"ADJACENT SECTIONS",21X,"IPRNT")                          00231000
  210 FORMAT(6(1H ),I4,F10.3,I6,3F10.4,64(1H ))                         00231100
  300 FORMAT(1H15X,"MATERIAL DATA"/1H 5X,"NCASE",I4///1H 5X,            00231200
     1"NMTLO=",I4//1H 5X,"NMTL",7X,"RHO",8X,"CP",7X,"TKX",7X,           00231300
     2"TKY",7X,"TKZ",6X,"PMSF",3X,"MATERIAL")                           00231400
  310 FORMAT(6(1H ),I4,2F10.3,43(1H ),8A4,15(1H ))                      00231500
  320 FORMAT(6(1H ),I4,2F10.3,43(1H ),6A4,A2,F9.1,12(1H ))              00231600
  400 FORMAT(1H15X,"GAP DATA"/1H 5X,"NCASE",I4///1H 5X,                 00231700
     1"NGAPO=",I4//1H 5X,"NGPI",2X,"NGPJ",6X,"GPL",5X,"GPAR",6X,        00231800
     2"TKG",6X,"TKC",5X,"EGPI",5X,"EGPJ",5X,"VFGP",5X,"DGP1",5X,        00231900
     3"DGP2",6X,"PGSF")                                                 00232000
  410 FORMAT(6(1H ),I4,I6,2F9.3,86(1H ))                                00232100
  500 FORMAT(1H15X,"OFFSET DATA"/1H 5X,"NCASE",I4///1H 5X,              00232200
     1"NOFSO=",I4//1H 5X,"NOFI",2X,"NOFJ",8X,"OFL1",8X,"OFL2")          00232300
  510 FORMAT(6(1H ),I4,I6,104(1H ))                                     00232400
  600 FORMAT(1H15X,"CONTACT COEFFICIENT DATA"/1H 5X,"NCASE",I4///       00232500
     11H 5X,"NCCTO=",I4//1H 5X,"NCCI",2X,"NCCJ",9X,"CCT"/               00232600
     2(1H 5X,I4,I6,F12.5))                                              00232700
  700 FORMAT(1H ////////1H 5X,"SIZING DATA"//1H 10X,"SIZET",5X,         00232800
     1"DEGSZ",5X,"NODSZ",5X,"METSZ",5X,"IDRSZ",5X,"IPNSZ",              00232900
     25X,"ITRSZ",5X"RDMIN"/1H 5X,2F10.3,5I10,F10.3)                     00233000
  710 FORMAT(1H15X,"SECTION DATA GEOMETRY"/1H 5X,"NCASE",I4///1H 5X,    00233100
     1"NSCTO=",I4//1H 5X,"NSCT",4X,"X-CORD",4X,"Y-CORD",4X,"Z-CORD",    00233200
     28X,"DX",8X,"DY",8X,"DZ",3X,"ADJACENT SECTIONS")                   00233300
  720 FORMAT(6(1H ),I4,6F10.4,50(1H ))                                  00233400
C                                                                       00233500
C     CONTROL DATA                                                      00233600
 1000 ICD=ICRD(2,0,DATA)                                                00233700
      NINFO=DATA(1)                                                     00233800
      NCASE=DATA(2)                                                     00233900
      DO 1001 I=1,15                                                    00234000
 1001 TITLE(I)=DATA(I+2)                                                00234100
      IF (NCASE.EQ.-1) GO TO 1002                                       00234200
      NCABS=IABS(NCASE)                                                 00234300
      IF (NCABS.LE.1000) GO TO 1004                                     00234400
      NCABS=NCABS-1000                                                  00234500
      IF (NCASE.LT.0) NCABS=-NCABS                                      00234600
      NCASE=NCABS                                                       00234700
 1002 IF (NCASE.EQ.-1) NCASE=1                                          00234800
      ICD=ICRD(8,1,DATA)                                                00234900
      SIZET=DATA(1)                                                     00235000
      DEGSZ=DATA(2)                                                     00235100
      NODSZ=DATA(3)                                                     00235200
      METSZ=DATA(4)                                                     00235300
      IDRSZ=DATA(5)                                                     00235400
      IPNSZ=DATA(6)                                                     00235500
      ITRSZ=DATA(7)                                                     00235600
      IF (ITRSZ.LE.0) ITRSZ=5                                           00235700
      RDMIN=DATA(8)                                                     00235800
      IF (RDMIN.LE.0.0) RDMIN=0.25                                      00235900
      ISIZE=1                                                           00236000
      SDRAT(1)=1.0                                                      00236100
 1004 IF (NCASE.EQ.0) NCASE=1                                           00236200
      NCABS=NCASE                                                       00236300
      NCASE=IABS(NCASE)                                                 00236400
      IF (NCASE.NE.1) GO TO 1005                                        00236500
      IF (IDOMT.EQ.0) CALL DOMT                                         00236600
      IDOMT=1                                                           00236700
 1005 NN=1                                                              00236800
      IF (NCASE.NE.1) NN=2                                              00236900
      DO 1010 I=1,36                                                    00237000
      INRR(I)=0                                                         00237100
      IF (I.LE.33) INPP(I)=0                                            00237101
 1010 INRO(I)=IBLK                                                      00237200
      IF (NCASE.NE.1) GO TO 1070                                        00237300
      DO 1020 I=1,36                                                    00237400
 1020 INPO(I)=IBLK                                                      00237500
      FTRN=0.5                                                          00237600
      DMTX=60.0                                                         00237700
      TOLR=0.05                                                         00237800
      RCMIN=BLK                                                         00237900
      NSCTO=0                                                           00238000
      NMTLO=0                                                           00238100
      NGAPO=0                                                           00238200
      NOFSO=0                                                           00238300
      NCCTO=0                                                           00238400
      ICRDR=0                                                           00238500
      ICRDP=0                                                           00238600
      DO 1025 I=1,3                                                     00238700
      DO 1025 J=1,300                                                   00238800
 1025 CORD(I,J)=0.0                                                     00238900
      DO 1030 I=1,3                                                     00239000
      NRSO(I)=0                                                         00239100
      NCO(I)=0                                                          00239200
      DO 1030 J=1,2                                                     00239300
      NAO(I,J)=0                                                        00239400
 1030 NRIO(I,J)=0                                                       00239500
      NVFO(1)=0                                                         00239600
      NVFO(2)=0                                                         00239700
      NKTO=0                                                            00239800
      NPCMO=0                                                           00239900
      DO 1050 I=1,5                                                     00240000
      YSCLE(1,I)=0.0                                                    00240100
      YSCLE(2,I)=0.0                                                    00240200
 1050 NCRTO(I)=0                                                        00240300
      TENRY=0.0                                                         00240400
      TDOWN=0.0                                                         00240500
 1070 IF (NCABS.GE.0) GO TO 1100                                        00240600
      REWIND 10                                                         00240700
      WRITE (6,150) NCASE                                               00240800
      DO 1080 I=1,99                                                    00240900
      READ (5,160) DATA8,SQ1,SQ2                                        00241000
      WRITE (6,170) DATA8                                               00241100
      WRITE (10,160) DATA8,SQ1,SQ2                                      00241200
      IF (DATA8(1).EQ.ENDM) GO TO 1090                                  00241300
 1080 CONTINUE                                                          00241400
      DATA8(1)=ENDM                                                     00241500
      WRITE (10,160) DATA8,SQ1,SQ2                                      00241600
 1090 REWIND 10                                                         00241700
 1100 WRITE (6,100) TITLE                                               00241800
      NCARD=0                                                           00241801
      DO 1130 I=1,NINFO                                                 00241900
      IF (NINFO.LE.0) GO TO 1120                                        00242000
      ICD=ICRD(12,1,DATA)                                               00242100
      IF (ICD.EQ.8) GO TO 1150                                          00242200
      NCARD=DATA(1)                                                     00242300
      IF (NCARD.LE.0) GO TO 1130                                        00242400
      IF (NCARD.GT.3) GO TO 1115                                        00242500
      DO 1110 J=2,12                                                    00242600
      JS=J+11*(NCARD-1)-1                                               00242700
      M=MSTD(2,1,2,INRO(JS),0,0.0,DATA(J))                              00242800
      IF (M.NE.0) INPO(JS)=INRO(JS)                                     00242900
      INRR(JS)=M                                                        00243000
 1110 CONTINUE                                                          00243100
 1115 IF (NCARD.NE.4) GO TO 1130                                        00243200
      M=MSTD(2,1,2,INRO(36),0,0,DATA(8))                                00243300
      IF (M.NE.0) INPO(36)=INRO(36)                                     00243400
 1120 IF (INPO(36).NE.2) GO TO 1125                                     00243500
      IF (NCASE.EQ.1) GO TO 1125                                        00243600
      IDLTO=NSCTO                                                       00243700
      DO 1121 J=1,NSCTO                                                 00243800
 1121 IDLT(J)=NSCT(J)                                                   00243900
      DO 1122 J=1,999                                                   00244000
 1122 IFTP(J)=NSCTL(J)                                                  00244100
      REWIND 11                                                         00244200
      READ (11) CM11,CM12,ICLOCK,CM21,CM22,CM3,CM4,CM5,CM6,             00244300
     1          CM7,CM91,CM92                                           00244400
      DO 1123 J=1,35                                                    00244500
      IF (INRR(J).NE.0) INPO(J)=INRO(J)                                 00244600
 1123 CONTINUE                                                          00244700
 1125 IF (NCARD.NE.4) GO TO 1130                                        00244800
      M=MSTD(NN,2,2,0,0,DELT,DATA(2))                                   00244900
      M=MSTD(NN,2,2,0,0,DELTP,DATA(3))                                  00245000
      M=MSTD(NN,2,2,0,0,TIMEO,DATA(4))                                  00245100
      M=MSTD(NN,2,2,0,0,TEND,DATA(5))                                   00245200
      M=MSTD(2,1,2,INRO(34),0,0,DATA(6))                                00245300
      IF (M.NE.0) INPO(34)=INRO(34)                                     00245400
      M=MSTD(2,1,2,INRO(35),0,0,DATA(7))                                00245500
      IF (M.NE.0) INPO(35)=INRO(35)                                     00245600
      M=MSTD(2,2,2,0,0,FTRN,DATA(9))                                    00245700
      M=MSTD(2,2,2,0,0,DMTX,DATA(10))                                   00245800
      M=MSTD(2,2,2,0,0,TOLR,DATA(11))                                   00245900
      M=MSTD(2,2,2,0,0,RCMIN,DATA(12))                                  00246000
 1130 CONTINUE                                                          00246100
 1150 IF (INPO(36).LT.1) GO TO 1180                                     00246200
      IF (NCASE.EQ.1) GO TO 1200                                        00246300
 1160 DO 1170 I=1,NSCTO                                                 00246400
      IS=I                                                              00246500
      IF (INPO(36).NE.2) GO TO 1170                                     00246600
      IS=IDLT(I)                                                        00246700
      IS=IFTP(IS)                                                       00246800
 1170 TO(I)=TN(IS)                                                      00246900
 1180 IF (NCABS.GE.0) GO TO 1200                                        00247000
      CALL MODS                                                         00247100
 1200 DO 1203 I=1,33                                                    00247200
      IDUM=INPP(I)                                                      00247201
      INPP(I)=INPO(I)                                                   00247202
      IF (NCASE.EQ.1) GO TO 1203                                        00247203
      IF (INPP(I).EQ.IBLK) GO TO 1203                                   00247204
      INPP(I)=INPP(I)+IDUM                                              00247205
      IF (INRO(I).EQ.1) INPP(I)=INPP(I)+10                              00247207
 1203 CONTINUE                                                          00247208
 1206 WRITE (6,105) NCASE                                               00247209
      ENCODE(120,106,AAA)                                               00247300
      DO 1220 I=1,3                                                     00247301
      IF (I.EQ.2) WRITE (6,110)                                         00247400
      IF (I.EQ.2) ENCODE(120,111,AAA)                                   00247401
      IF (I.EQ.3) WRITE (6,120)                                         00247500
      IF (I.EQ.3) ENCODE(120,121,AAA)                                   00247501
      IS=-2                                                             00247600
      DO 1210 J=1,11                                                    00247700
      IW=10                                                             00247800
      IF (J.GT.4) IW=8                                                  00247900
      IS=IS+IW                                                          00248000
      IF (J.EQ.5) IS=IS+2                                               00248100
      JS=11*(I-1)+J                                                     00248200
      M=MPTD(1,IS,IW,0,INPP(JS),0.0)                                    00248300
      IF (INPP(JS).EQ.IBLK) INPP(JS)=0                                  00248301
 1210 CONTINUE                                                          00248400
      WRITE (6,101) AAA                                                 00248401
 1220 CONTINUE                                                          00248402
      WRITE (6,130)                                                     00248403
      ENCODE(120,131,AAA) DELT,DELTP,TIMEO,TEND,FTRN,DMTX,TOLR          00248500
      M=MPTD(1,48,8,0,INPO(34),0.0)                                     00248600
      M=MPTD(1,56,8,0,INPO(35),0.0)                                     00248700
      M=MPTD(1,64,8,0,INPO(36),0.0)                                     00248800
      M=MPTD(2,96,8,2,0,RCMIN)                                          00248900
      WRITE (6,101) AAA                                                 00248901
      FTRT=3600.0                                                       00249000
      IF (INPO(34).EQ.1) FTRT=1.0                                       00249100
      IF (ISIZE.GT.0)                                                   00249200
     *WRITE (6,700) SIZET,DEGSZ,NODSZ,METSZ,IDRSZ,IPNSZ,ITRSZ,RDMIN     00249300
      IDLTO=0                                                           00249400
C                                                                       00249500
C     SECTION DATA                                                      00249600
 2000 IF (INRO(1).NE.1) GO TO 2100                                      00249700
      ICD=ICRD(1,2,DATA)                                                00249800
      NW=DATA(1)                                                        00249900
      ICRDR=0                                                           00250000
      IF (DATA(2).EQ.CRDRT) ICRDR=1                                     00250100
      IDLTO=0                                                           00250200
      IF (NW.EQ.0) GO TO 2100                                           00250300
      DO 2070 I=1,NW                                                    00250400
      ICD=ICRD(6,2,DATA)                                                00250500
      IF (ICD.EQ.8) GO TO 2075                                          00250600
      N=DATA(1)                                                         00250700
      IF (N.EQ.0) GO TO 2070                                            00250800
      NI=LONP(N,NSCTO,NSCT)                                             00250900
      IF (N.GT.0) GO TO 2040                                            00251000
 2010 NSCTO=NSCTO-1                                                     00251100
      N=-N                                                              00251200
      IDLTO=IDLTO+1                                                     00251300
      IDLT(IDLTO)=N                                                     00251400
      IF (NI.GT.NSCTO) GO TO 2070                                       00251500
      DO 2020 J=NI,NSCTO                                                00251600
      JS=J+1                                                            00251700
      NSCT(J)=NSCT(JS)                                                  00251800
      TO(J)=TO(JS)                                                      00251900
      MTLN(J)=MTLN(JS)                                                  00252000
      DX(J)=DX(JS)                                                      00252100
      DY(J)=DY(JS)                                                      00252200
      DZ(J)=DZ(JS)                                                      00252300
      IPRNT(J)=IPRNT(JS)                                                00252400
      IF (ICRDP.EQ.0) GO TO 2015                                        00252500
      ICRDP=ICRDP-1                                                     00252600
      CORD(1,J)=CORD(1,JS)                                              00252700
      CORD(2,J)=CORD(2,JS)                                              00252800
      CORD(3,J)=CORD(3,JS)                                              00252900
 2015 DO 2020 K=1,5                                                     00253000
      NAJ(K,J)=NAJ(K,JS)                                                00253100
 2020 CONTINUE                                                          00253200
      GO TO 2070                                                        00253300
 2040 IB=2                                                              00253400
      IF (NI.GT.0) GO TO 2050                                           00253500
      NSCTO=NSCTO+1                                                     00253600
      NI=NSCTO                                                          00253700
      IB=1                                                              00253800
 2050 IF (NCASE.EQ.1) IB=1                                              00253900
      NSCT(NI)=N                                                        00254000
      M=MSTD(IB,2,2,0,0,TO(NI),DATA(2))                                 00254100
      M=MSTD(IB,1,2,MTLN(NI),0,0.0,DATA(3))                             00254200
      M=MSTD(IB,2,2,0,0,DX(NI),DATA(4))                                 00254300
      M=MSTD(IB,2,2,0,0,DY(NI),DATA(5))                                 00254400
      M=MSTD(IB,2,2,0,0,DZ(NI),DATA(6))                                 00254500
      M=MSTD(IB,1,2,IPRNT(NI),0,0.0,DATA(12))                           00254600
      IF (IPRNT(NI).EQ.0) IPRNT(NI)=IBLK                                00254700
      DO 2060 J=1,5                                                     00254800
      JS=6+J                                                            00254900
      M=MSTD(IB,1,2,NAJ(J,NI),0,0.0,DATA(JS))                           00255000
 2060 CONTINUE                                                          00255100
      M=LONP(N,IDLTO,IDLT)                                              00255200
      IF (M.LE.0) GO TO 2070                                            00255300
      IDLTO=IDLTO-1                                                     00255400
      DO 2065 J=M,IDLTO                                                 00255500
      JS=J+1                                                            00255600
 2065 IDLT(J)=IDLT(JS)                                                  00255700
 2070 CONTINUE                                                          00255800
 2075 IF (NCASE.EQ.1) GO TO 2100                                        00255900
      IF (IDLTO.EQ.0) GO TO 2100                                        00256000
      DO 2080 I=1,IDLTO                                                 00256100
      M=IDLT(I)                                                         00256200
      DO 2080 J=1,NSCTO                                                 00256300
      DO 2080 K=1,5                                                     00256400
      ISTN=NAJ(K,J)-10000*(NAJ(K,J)/10000)                              00256500
      IF (M.EQ.ISTN) NAJ(K,J)=IBLK                                      00256600
 2080 CONTINUE                                                          00256700
 2100 IPNT=IABS(INPO(35))                                               00256800
      IF (NCASE.EQ.1) IPNT=1                                            00256801
      IF (IPNT.GT.99.AND.INPP(1).LE.1) GO TO 2130                       00256802
 2110 WRITE (6,200) NCASE,NSCTO                                         00256900
      DO 2125 I=1,NSCTO                                                 00257000
      ENCODE(120,210,AAA) NSCT(I),TO(I),MTLN(I),DX(I),DY(I),DZ(I)       00257100
      M=MPTD(1,96,5,0,IPRNT(I),0.0)                                     00257200
      DO 2120 J=1,5                                                     00257300
      IS=58+7*(J-1)                                                     00257400
      M=MPTD(1,IS,7,-1,NAJ(J,I),0.0)                                    00257500
 2120 CONTINUE                                                          00257600
      WRITE (6,101) AAA                                                 00257601
 2125 CONTINUE                                                          00257602
 2130 IF (ICRDR.NE.0) ICRDP=NSCTO                                       00257700
      IF (ICRDP.NE.0) ICRDP=NSCTO                                       00257800
C                                                                       00257900
C     SECTION DATA GEOMETRY                                             00258000
 2500 IF (ICRDR.EQ.0) GO TO 2600                                        00258100
      IF (INRO(1).NE.1) GO TO 2600                                      00258200
      ICD=ICRD(1,2,DATA)                                                00258300
      NW=DATA(1)                                                        00258400
      IF (NW.EQ.0) GO TO 2600                                           00258500
      DO 2560 I=1,NW                                                    00258600
      ICD=ICRD(4,3,DATA)                                                00258700
      IF (ICD.EQ.8) GO TO 2600                                          00258800
      N=DATA(1)                                                         00258900
      IF (N.EQ.0) GO TO 2560                                            00259000
      NI=LONP(N,NSCTO,NSCT)                                             00259100
      IF (N.GT.0) GO TO 2530                                            00259200
      IF (NI.EQ.0) GO TO 2560                                           00259300
 2510 CORD(1,NI)=0.0                                                    00259400
      CORD(2,NI)=0.0                                                    00259500
      CORD(3,NI)=0.0                                                    00259600
      GO TO 2560                                                        00259700
 2530 IB=2                                                              00259800
      IF (NI.EQ.0) GO TO 2560                                           00259900
 2540 IF (NCASE.EQ.1) IB=1                                              00260000
      M=MSTD(IB,2,2,0,0,CORD(1,NI),DATA(2))                             00260100
      M=MSTD(IB,2,2,0,0,CORD(2,NI),DATA(3))                             00260200
      M=MSTD(IB,2,2,0,0,CORD(3,NI),DATA(4))                             00260300
 2560 CONTINUE                                                          00260400
 2600 IF (ICRDP.EQ.0) GO TO 3000                                        00260500
      IF (IPNT.GT.99.AND.INPP(1).LE.1) GO TO 3000                       00260501
      WRITE (6,710) NCASE,NSCTO                                         00260600
      DO 2625 I=1,NSCTO                                                 00260700
      ENCODE(120,720,AAA) NSCT(I),(CORD(J,I),J=1,3),DX(I),DY(I),DZ(I)   00260800
      DO 2620 J=1,5                                                     00260900
      IS=72+7*(J-1)                                                     00261000
      M=MPTD(1,IS,7,-1,NAJ(J,I),0.0)                                    00261100
 2620 CONTINUE                                                          00261200
      WRITE (6,101) AAA                                                 00261201
 2625 CONTINUE                                                          00261202
C                                                                       00261300
C     MATERIAL DATA                                                     00261400
 3000 IF (NCASE.EQ.1) GO TO 3100                                        00261500
      IF (IDLTO.EQ.0) GO TO 3100                                        00261600
      NW=NMTLO                                                          00261700
      DO 3030 I=1,NW                                                    00261800
 3005 IF (I.GT.NMTLO) GO TO 3100                                        00261900
      M=NMTL(I)                                                         00262000
      IF (M.GT.1000) GO TO 3007                                         00262100
      IF (M.GT.100) M=M-100                                             00262200
 3007 DO 3010 J=1,NSCTO                                                 00262300
      IF (M.EQ.MTLN(J)) GO TO 3030                                      00262400
 3010 CONTINUE                                                          00262500
      NMTLO=NMTLO-1                                                     00262600
      IF (NMTLO.EQ.0) GO TO 3100                                        00262700
      NI=I                                                              00262800
      IF (NI.GT.NMTLO) GO TO 3030                                       00262900
      DO 3020 J=NI,NMTLO                                                00263000
      JS=J+1                                                            00263100
      NMTL(J)=NMTL(JS)                                                  00263200
      RHO(J)=RHO(JS)                                                    00263300
      CP(J)=CP(JS)                                                      00263400
      TKX(J)=TKX(JS)                                                    00263500
      TKY(J)=TKY(JS)                                                    00263600
      TKZ(J)=TKZ(JS)                                                    00263700
      PMSF(J)=PMSF(JS)                                                  00263800
      DO 3020 K=1,8                                                     00263900
      BCDM(K,J)=BCDM(K,JS)                                              00264000
 3020 CONTINUE                                                          00264100
      GO TO 3005                                                        00264200
 3030 CONTINUE                                                          00264300
 3100 IF (INRO(2).NE.1) GO TO 3200                                      00264400
      ICD=ICRD(1,3,DATA)                                                00264500
      NW=DATA(1)                                                        00264600
      IF (NW.EQ.0) GO TO 3200                                           00264700
      DO 3160 I=1,NW                                                    00264800
      ICD=ICRD(7,3,DATA)                                                00264900
      IF (ICD.EQ.8) GO TO 3200                                          00265000
      N=DATA(1)                                                         00265100
      IF (N.EQ.0) GO TO 3160                                            00265200
      NI=LONP(N,NMTLO,NMTL)                                             00265300
      IF (N.GT.0) GO TO 3130                                            00265400
      IF (NI.EQ.0) GO TO 3160                                           00265500
 3110 NMTLO=NMTLO-1                                                     00265600
      IF (NI.GT.NMTLO) GO TO 3160                                       00265700
      DO 3120 J=NI,NMTLO                                                00265800
      JS=J+1                                                            00265900
      NMTL(J)=NMTL(JS)                                                  00266000
      RHO(J)=RHO(JS)                                                    00266100
      CP(J)=CP(JS)                                                      00266200
      TKX(J)=TKX(JS)                                                    00266300
      TKY(J)=TKY(JS)                                                    00266400
      TKZ(J)=TKZ(JS)                                                    00266500
      PMSF(J)=PMSF(JS)                                                  00266600
      DO 3120 K=1,8                                                     00266700
      BCDM(K,J)=BCDM(K,JS)                                              00266800
 3120 CONTINUE                                                          00266900
      GO TO 3160                                                        00267000
 3130 IB=2                                                              00267100
      IF (NI.GT.0) GO TO 3140                                           00267200
      NMTLO=NMTLO+1                                                     00267300
      NI=NMTLO                                                          00267400
      IB=1                                                              00267500
 3140 IF (NCASE.EQ.1) IB=1                                              00267600
      NMTL(NI)=N                                                        00267700
      M=MSTD(IB,2,2,0,0,RHO(NI),DATA(2))                                00267800
      M=MSTD(IB,2,2,0,0,CP(NI),DATA(3))                                 00267900
      M=MSTD(IB,2,2,0,0,TKX(NI),DATA(4))                                00268000
      M=MSTD(IB,2,2,0,0,TKY(NI),DATA(5))                                00268100
      M=MSTD(IB,2,2,0,0,TKZ(NI),DATA(6))                                00268200
      M=MSTD(IB,2,2,0,0,PMSF(NI),DATA(7))                               00268300
      DO 3150 J=1,8                                                     00268400
      M=MSTD(IB,2,2,0,0,BCDM(J,NI),DATA(J+7))                           00268500
 3150 CONTINUE                                                          00268600
 3160 CONTINUE                                                          00268700
 3200 IF (IPNT.GT.99.AND.INPP(2).LE.1) GO TO 4000                       00268800
 3210 WRITE (6,300) NCASE,NMTLO                                         00268900
      DO 3220 I=1,NMTLO                                                 00269000
      IMTL=NMTL(I)                                                      00269100
      IF (IMTL.LT.1000) ENCODE(120,310,AAA) IMTL,RHO(I),CP(I),          00269200
     1(BCDM(J,I),J=1,8)                                                 00269300
      IF (IMTL.GE.1000) ENCODE(120,320,AAA) IMTL,RHO(I),CP(I),          00269400
     1(BCDM(J,I),J=1,8)                                                 00269500
      M=MPTD(2,29,10,3,0,TKX(I))                                        00269600
      M=MPTD(2,39,10,3,0,TKY(I))                                        00269700
      M=MPTD(2,49,10,3,0,TKZ(I))                                        00269800
      M=MPTD(2,59,10,3,0,PMSF(I))                                       00269900
      WRITE (6,101) AAA                                                 00269901
 3220 CONTINUE                                                          00270000
C                                                                       00270100
C     GAP DATA                                                          00270200
 4000 IF (NCASE.EQ.1) GO TO 4100                                        00270300
      IF (INPO(3).EQ.0) NGAPO=0                                         00270400
      IF (IDLTO.EQ.0) GO TO 4100                                        00270500
      NW=NGAPO                                                          00270600
      IF (NW.EQ.0) GO TO 4100                                           00270700
      DO 4040 I=1,NW                                                    00270800
 4005 IF (I.GT.NGAPO) GO TO 4100                                        00270900
      MI=NGPI(I)                                                        00271000
      MJ=NGPJ(I)                                                        00271100
      DO 4010 J=1,IDLTO                                                 00271200
      IF (IDLT(J).EQ.MI) GO TO 4020                                     00271300
      IF (IDLT(J).EQ.MJ) GO TO 4020                                     00271400
 4010 CONTINUE                                                          00271500
      GO TO 4040                                                        00271600
 4020 NGAPO=NGAPO-1                                                     00271700
      IF (NGAPO.EQ.0) GO TO 4100                                        00271800
      NI=I                                                              00271900
      IF (NI.GT.NGAPO) GO TO 4040                                       00272000
      DO 4030 J=NI,NGAPO                                                00272100
      JS=J+1                                                            00272200
      NGPI(J)=NGPI(JS)                                                  00272300
      NGPJ(J)=NGPJ(JS)                                                  00272400
      GPL(J)=GPL(JS)                                                    00272500
      GPAR(J)=GPAR(JS)                                                  00272600
      TKG(J)=TKG(JS)                                                    00272700
      TKC(J)=TKC(JS)                                                    00272800
      EGPI(J)=EGPI(JS)                                                  00272900
      EGPJ(J)=EGPJ(JS)                                                  00273000
      VFGP(J)=VFGP(JS)                                                  00273100
      DGP1(J)=DGP1(JS)                                                  00273200
      DGP2(J)=DGP2(JS)                                                  00273300
 4030 PGSF(J)=PGSF(JS)                                                  00273400
      GO TO 4005                                                        00273500
 4040 CONTINUE                                                          00273600
 4100 IF (INRO(3).NE.1) GO TO 4200                                      00273700
      ICD=ICRD(1,4,DATA)                                                00273800
      NW=DATA(1)                                                        00273900
      IF (NW.EQ.0) GO TO 4200                                           00274000
      DO 4150 I=1,NW                                                    00274100
      ICD=ICRD(12,4,DATA)                                               00274200
      IF (ICD.EQ.8) GO TO 4200                                          00274300
      N=DATA(1)                                                         00274400
      IF (N.EQ.0) GO TO 4150                                            00274500
      NJ=DATA(2)                                                        00274600
      NI=LOAP(N,NJ,NGAPO,NGPI,NGPJ)                                     00274700
      IF (N.GT.0) GO TO 4130                                            00274800
      IF (NI.EQ.0) GO TO 4150                                           00274900
 4110 NGAPO=NGAPO-1                                                     00275000
      IF (NI.GT.NGAPO) GO TO 4150                                       00275100
      DO 4120 J=NI,NGAPO                                                00275200
      JS=J+1                                                            00275300
      NGPI(J)=NGPI(JS)                                                  00275400
      NGPJ(J)=NGPJ(JS)                                                  00275500
      GPL(J)=GPL(JS)                                                    00275600
      GPAR(J)=GPAR(JS)                                                  00275700
      TKG(J)=TKG(JS)                                                    00275800
      TKC(J)=TKC(JS)                                                    00275900
      EGPI(J)=EGPI(JS)                                                  00276000
      EGPJ(J)=EGPJ(JS)                                                  00276100
      VFGP(J)=VFGP(JS)                                                  00276200
      DGP1(J)=DGP1(JS)                                                  00276300
      DGP2(J)=DGP2(JS)                                                  00276400
 4120 PGSF(J)=PGSF(JS)                                                  00276500
      GO TO 4150                                                        00276600
 4130 IB=2                                                              00276700
      IF (NI.GT.0) GO TO 4140                                           00276800
      NGAPO=NGAPO+1                                                     00276900
      NI=NGAPO                                                          00277000
      IB=1                                                              00277100
 4140 IF (NCASE.EQ.1) IB=1                                              00277200
      NGPI(NI)=N                                                        00277300
      M=MSTD(IB,1,2,NGPJ(NI),0,0.0,DATA(2))                             00277400
      M=MSTD(IB,2,2,0,0,GPL(NI),DATA(3))                                00277500
      M=MSTD(IB,2,2,0,0,GPAR(NI),DATA(4))                               00277600
      M=MSTD(IB,2,2,0,0,TKG(NI),DATA(5))                                00277700
      M=MSTD(IB,2,2,0,0,TKC(NI),DATA(6))                                00277800
      M=MSTD(IB,2,2,0,0,EGPI(NI),DATA(7))                               00277900
      M=MSTD(IB,2,2,0,0,EGPJ(NI),DATA(8))                               00278000
      M=MSTD(IB,2,2,0,0,VFGP(NI),DATA(9))                               00278100
      M=MSTD(IB,2,2,0,0,DGP1(NI),DATA(10))                              00278200
      M=MSTD(IB,2,2,0,0,DGP2(NI),DATA(11))                              00278300
      M=MSTD(IB,2,2,0,0,PGSF(NI),DATA(12))                              00278400
 4150 CONTINUE                                                          00278500
 4200 IF (INPO(3).NE.1) GO TO 5000                                      00278600
      IF (NGAPO.EQ.0) GO TO 5000                                        00278700
      IF (IPNT.GT.99.AND.INPP(3).LE.1) GO TO 5000                       00278701
 4210 WRITE (6,400) NCASE,NGAPO                                         00278800
      DO 4220 I=1,NGAPO                                                 00278900
      ENCODE(120,410,AAA) NGPI(I),NGPJ(I),GPL(I),GPAR(I)                00279000
      M=MPTD(2,33,9,3,0,TKG(I))                                         00279100
      M=MPTD(2,42,9,3,0,TKC(I))                                         00279200
      M=MPTD(2,51,9,3,0,EGPI(I))                                        00279300
      M=MPTD(2,60,9,3,0,EGPJ(I))                                        00279400
      M=MPTD(2,69,9,3,0,VFGP(I))                                        00279500
      M=MPTD(2,78,9,3,0,DGP1(I))                                        00279600
      M=MPTD(2,87,9,3,0,DGP2(I))                                        00279700
      M=MPTD(2,96,10,3,0,PGSF(I))                                       00279800
      WRITE (6,101) AAA                                                 00279801
 4220 CONTINUE                                                          00279900
C                                                                       00280000
C     OFFSET DATA                                                       00280100
 5000 IF (NCASE.EQ.1) GO TO 5100                                        00280200
      IF (INPO(4).EQ.0) NOFSO=0                                         00280300
      IF (IDLTO.EQ.0) GO TO 5100                                        00280400
      NW=NOFSO                                                          00280500
      IF (NW.EQ.0) GO TO 5100                                           00280600
      DO 5040 I=1,NW                                                    00280700
 5005 IF (I.GT.NOFSO) GO TO 5100                                        00280800
      MI=NOFI(I)                                                        00280900
      MJ=NOFJ(I)                                                        00281000
      DO 5010 J=1,IDLTO                                                 00281100
      IF (IDLT(J).EQ.MI) GO TO 5020                                     00281200
      IF (IDLT(J).EQ.MJ) GO TO 5020                                     00281300
 5010 CONTINUE                                                          00281400
      GO TO 5040                                                        00281500
 5020 NOFSO=NOFSO-1                                                     00281600
      IF (NOFSO.EQ.0) GO TO 5100                                        00281700
      NI=I                                                              00281800
      IF (NI.GT.NOFSO) GO TO 5040                                       00281900
      DO 5030 J=NI,NOFSO                                                00282000
      JS=J+1                                                            00282100
      NOFI(J)=NOFI(JS)                                                  00282200
      NOFJ(J)=NOFJ(JS)                                                  00282300
      OFL1(J)=OFL1(JS)                                                  00282400
 5030 OFL2(J)=OFL2(JS)                                                  00282500
      GO TO 5005                                                        00282600
 5040 CONTINUE                                                          00282700
 5100 IF (INRO(4).NE.1) GO TO 5200                                      00282800
      ICD=ICRD(1,5,DATA)                                                00282900
      NW=DATA(1)                                                        00283000
      IF (NW.EQ.0) GO TO 5200                                           00283100
      DO 5150 I=1,NW                                                    00283200
      ICD=ICRD(4,5,DATA)                                                00283300
      IF (ICD.EQ.8) GO TO 5200                                          00283400
      N=DATA(1)                                                         00283500
      IF (N.EQ.0) GO TO 5150                                            00283600
      NJ=DATA(2)                                                        00283700
      NI=LOAP(N,NJ,NOFSO,NOFI,NOFJ)                                     00283800
      IF (N.GT.0) GO TO 5130                                            00283900
      IF (NI.EQ.0) GO TO 5150                                           00284000
 5110 NOFSO=NOFSO-1                                                     00284100
      IF (NI.GT.NOFSO) GO TO 5150                                       00284200
      DO 5120 J=NI,NOFSO                                                00284300
      JS=J+1                                                            00284400
      NOFI(J)=NOFI(JS)                                                  00284500
      NOFJ(J)=NOFJ(JS)                                                  00284600
      OFL1(J)=OFL1(JS)                                                  00284700
 5120 OFL2(J)=OFL2(JS)                                                  00284800
      GO TO 5150                                                        00284900
 5130 IB=2                                                              00285000
      IF (NI.GT.0) GO TO 5140                                           00285100
      NOFSO=NOFSO+1                                                     00285200
      NI=NOFSO                                                          00285300
      IB=1                                                              00285400
 5140 IF (NCASE.EQ.1) IB=1                                              00285500
      NOFI(NI)=N                                                        00285600
      M=MSTD(IB,1,2,NOFJ(NI),0,0.0,DATA(2))                             00285700
      M=MSTD(IB,2,2,0,0,OFL1(NI),DATA(3))                               00285800
      M=MSTD(IB,2,2,0,0,OFL2(NI),DATA(4))                               00285900
 5150 CONTINUE                                                          00286000
 5200 IF (INPO(4).NE.1) GO TO 6000                                      00286100
      IF (IPNT.GT.99.AND.INPP(4).LE.1) GO TO 6000                       00286101
      IF (NOFSO.EQ.0) GO TO 6000                                        00286200
 5210 WRITE (6,500) NCASE,NOFSO                                         00286300
      DO 5220 I=1,NOFSO                                                 00286400
      ENCODE(120,510,AAA) NOFI(I),NOFJ(I)                               00286500
      M=MPTD(2,15,12,5,0,OFL1(I))                                       00286600
      M=MPTD(2,27,12,5,0,OFL2(I))                                       00286700
      WRITE (6,101) AAA                                                 00286701
 5220 CONTINUE                                                          00286800
C                                                                       00286900
C     CONTACT COEFFICIENT DATA                                          00287000
 6000 IF (NCASE.EQ.1) GO TO 6100                                        00287100
      IF (INPO(5).EQ.0) NCCTO=0                                         00287200
      IF (IDLTO.EQ.0) GO TO 6100                                        00287300
      NW=NCCTO                                                          00287400
      IF (NW.EQ.0) GO TO 6100                                           00287500
      DO 6040 I=1,NW                                                    00287600
 6005 IF (I.GT.NCCTO) GO TO 6100                                        00287700
      MI=NCCI(I)                                                        00287800
      MJ=NCCJ(I)                                                        00287900
      DO 6010 J=1,IDLTO                                                 00288000
      IF (IDLT(J).EQ.MI) GO TO 6020                                     00288100
      IF (IDLT(J).EQ.MJ) GO TO 6020                                     00288200
 6010 CONTINUE                                                          00288300
      GO TO 6040                                                        00288400
 6020 NCCTO=NCCTO-1                                                     00288500
      IF (NCCTO.EQ.0) GO TO 6100                                        00288600
      NI=I                                                              00288700
      IF (NI.GT.NCCTO) GO TO 6040                                       00288800
      DO 6030 J=NI,NCCTO                                                00288900
      JS=J+1                                                            00289000
      NCCI(J)=NCCI(JS)                                                  00289100
      NCCJ(J)=NCCJ(JS)                                                  00289200
 6030 CCT(J)=CCT(JS)                                                    00289300
      GO TO 6005                                                        00289400
 6040 CONTINUE                                                          00289500
 6100 IF (INRO(5).NE.1) GO TO 6200                                      00289600
      ICD=ICRD(1,6,DATA)                                                00289700
      NW=DATA(1)                                                        00289800
      IF (NW.EQ.0) GO TO 6200                                           00289900
      DO 6150 I=1,NW                                                    00290000
      ICD=ICRD(3,6,DATA)                                                00290100
      IF (ICD.EQ.8) GO TO 6200                                          00290200
      N=DATA(1)                                                         00290300
      IF (N.EQ.0) GO TO 6150                                            00290400
      NJ=DATA(2)                                                        00290500
      NI=LOAP(N,NJ,NCCTO,NCCI,NCCJ)                                     00290600
      IF (N.GT.0) GO TO 6130                                            00290700
      IF (NI.EQ.0) GO TO 6150                                           00290800
 6110 NCCTO=NCCTO-1                                                     00290900
      IF (NI.GT.NCCTO) GO TO 6150                                       00291000
      DO 6120 J=NI,NCCTO                                                00291100
      JS=J+1                                                            00291200
      NCCI(J)=NCCI(JS)                                                  00291300
      NCCJ(J)=NCCJ(JS)                                                  00291400
 6120 CCT(J)=CCT(JS)                                                    00291500
      GO TO 6150                                                        00291600
 6130 IB=2                                                              00291700
      IF (NI.GT.0) GO TO 6140                                           00291800
      NCCTO=NCCTO+1                                                     00291900
      NI=NCCTO                                                          00292000
      IB=1                                                              00292100
 6140 IF (NCASE.EQ.1) IB=1                                              00292200
      NCCI(NI)=N                                                        00292300
      M=MSTD(IB,1,2,NCCJ(NI),0,0.0,DATA(2))                             00292400
      M=MSTD(IB,2,2,0,0,CCT(NI),DATA(3))                                00292500
 6150 CONTINUE                                                          00292600
 6200 IF (INPO(5).NE.1) GO TO 9000                                      00292700
      IF (IPNT.GT.99.AND.INPP(5).LE.1) GO TO 9000                       00292701
      IF (NCCTO.EQ.0) GO TO 9000                                        00292800
 6210 WRITE (6,600) NCASE,NCCTO,(NCCI(I),NCCJ(I),CCT(I),I=1,NCCTO)      00292900
C                                                                       00293000
C     EXIT                                                              00293100
 9000 RETURN                                                            00293200
      END                                                               00293300
*DECK MODS                                                              00293301
C     SUBROUTINE MODS OF PROGRAM XF0031                                 00293400
C     L.W. FESLER     41-383/530  X4263                                 00293500
C                                                                       00293600
C                *****      *****      *****      *****                 00293700
C                                                                       00293800
C     THIS SUBROUTINE CHANGES THE INPUT DATA FROM THE PREVIOUS CASE     00293900
C     BEFORE NEW INPUT DATA IS READ.                                    00294000
C                                                                       00294100
C                *****      *****      *****      *****                 00294200
C                                                                       00294300
      SUBROUTINE MODS                                                   00294400
C                                                                       00294500
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00294600
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00294700
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00294800
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00294900
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00295000
     5              ICLOCK,IDOMT,INPP(33)                               00295001
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00295100
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00295200
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00295300
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00295400
      COMMON /CMN3/ TBSTG(4000),TBID(14,99)                             00295500
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00295600
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00295700
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00295800
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00295900
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00296000
     2              DGP2(75),PGSF(75),BQGP(75),                         00296100
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00296200
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00296300
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00296400
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00296500
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00296600
     3              FP(75,3,2),BQA(75,3,2),                             00296700
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00296800
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00296900
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00297000
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00297100
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00297200
      COMMON /CMN7/ NRIO(3,2),NRI(25,3,2),ERI(25,3,2),DRI(25,3,2),      00297300
     1              ZRI(25,3,2),NAVT(2),BVT(40,40,2),NBVT(40,2),        00297400
     2              NVFO(2),NVFI(750,2),NVFJ(750,2),VFIJ(750,2)         00297500
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00297600
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00297700
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL,            00297800
     3              IMET(300),ICOET(8,300)                              00297900
      COMMON /CMN9/ NCRTO(5),NCRT(11,50,5),NCSEO,NCSE(300),NCSSO,       00298000
     1              NCSS(99),NCPT(99),NHLDO,NHLD(300),NHRTO,NHRT(300)   00298100
C                                                                       00298200
      DIMENSION ARY4(20),AR1(1),AR2(1),AR3(1),AR4(1),AR5(1),            00298300
     1          AR6(1),AR7(1),AR8(1),AR9(1)                             00298400
      EQUIVALENCE (VALUE,IVALUE),(AR1(1),NCASE),(AR2(1),NSCTL(1)),      00298500
     1            (AR3(1),TBSTG(1)),(AR4(1),NMTLO),(AR5(1),NGAPO),      00298600
     2            (AR6(1),NAO(1,1)),(AR7(1),NRIO(1,1)),                 00298700
     3            (AR8(1),CAP(1)),(AR9(1),NCRTO(1))                     00298800
      REAL      ARY8(12),TEST,ENDM,SIZE,VFTR,BLK8                       00298900
      REAL      NAME1(30),NAME2(20),NAME3(05),NAME4(15),NAME5(25),      00299000
     1          NAME6(40),NAME7(15),NAME8(20),NAME9(15)                 00299100
      DIMENSION ILOC1(30),ILOC2(20),ILOC3(05),ILOC4(15),ILOC5(25),      00299200
     1          ILOC6(40),ILOC7(15),ILOC8(20),ILOC9(15)                 00299300
      DIMENSION ARYY(20)                                                00299400
      REAL   R1,R2,S1,S2,DR1,DR2,DS1,DS2,DD32,DDS2,DD02                 00299500
      DATA ENDM,SIZE,VFTR,BLK8 / "ENDM","SIZE","VFTR","    " /          00299501
C                                                                       00299600
  100 FORMAT(12A6,T1,20A4)                                              00299700
  110 FORMAT(6X,5I6,6F6.0)                                              00299800
  120 FORMAT(20A4)                                                      00299801
C                                                                       00299900
      DATA NAME1 / "NCASE ","INPO  ","INRO  ","DELT  ","DELTP ",        00300000
     1             "TIMEO ","TEND  ","FTRN  ","DMTX  ","TOLR  ",        00300100
     2             "RCMIN ","DELTC ","TIMEC ","TIMEP ","NSCTO ",        00300200
     3             "NSCT  ","NOPT  ","NSPTO ","NSPT  ","NAOO  ",        00300300
     4             "NRSOO ","NRIOO ","NCOO  ","NCRTOO","FTRT  ",        00300400
     5             "FTRM  ","TIME1 ","TOLRE ","TOLR1 ","      " /       00300500
      DATA NAME2 / "NSCTL ","TO    ","MTLN  ","DX    ","DY    ",        00300600
     1             "DZ    ","NAJ   ","IPRNT ","IDLTO ","IDLT  ",        00300700
     2             "TN    ","IFTP  ","NOSC  ","IOSC  ","COET  ",        00300800
     3             "BCOET ","PCQL  ","IPCT  ","      ","      " /       00300900
      DATA NAME3 / "TBSTG ","TBID  ","      ","      ","      " /       00301000
      DATA NAME4 / "NMTLO ","NMTL  ","RHO   ","CP    ","TKX   ",        00301100
     1             "TKY   ","TKZ   ","PMSF  ","BCDM  ","NPCMO ",        00301200
     2             "NPCM  ","TPCM  ","QPCM  ","BCDP  ","      " /       00301300
      DATA NAME5 / "NGAPO ","NGPI  ","NGPJ  ","GPL   ","GPAR  ",        00301400
     1             "TKG   ","TKC   ","EGPI  ","EGPJ  ","VFGP  ",        00301500
     2             "DGP1  ","DGP2  ","PGSF  ","BQGP  ","NOFSO ",        00301600
     3             "NOFI  ","NOFJ  ","OFL1  ","OFL2  ","NCCTO ",        00301700
     4             "NCCI  ","NCCJ  ","CCT   ","      ","      " /       00301800
      DATA NAME6 / "NAO   ","NA    ","FA    ","QA    ","AA    ",        00301900
     1             "DA    ","ZA    ","ITA   ","HR    ","FR    ",        00302000
     2             "TR    ","PR    ","FP    ","BQA   ","NRSO  ",        00302100
     3             "NRS   ","FRS   ","ERS   ","TRS   ","DRS   ",        00302200
     4             "ZRS   ","BQRS  ","NCO   ","NC    ","FC    ",        00302300
     5             "HC    ","TC    ","DC    ","ZC    ","ITC   ",        00302400
     6             "NCI   ","NCJ   ","BQC   ","NKTO  ","NKT   ",        00302500
     7             "TNKT  ","INKT  ","      ","      ","      " /       00302600
      DATA NAME7 / "NRIO  ","NRI   ","ERI   ","DRI   ","ZRI   ",        00302700
     1             "NAVT  ","BVT   ","NBVT  ","NVFO  ","NVFI  ",        00302800
     2             "NVFJ  ","VFIJ  ","      ","      ","      " /       00302900
      DATA NAME8 / "CAP   ","QTOT  ","TL    ","TL1   ","TL2   ",        00303000
     1             "SLPO  ","SLP   ","TPD   ","TCR   ","ICAPT ",        00303100
     2             "ICOND ","IOST  ","IOSN  ","ITER  ","IBDM  ",        00303200
     3             "IADR  ","IL    ","IMET  ","ICOET ","      " /       00303300
      DATA NAME9 / "NCRTO ","NCRT  ","NCSEO ","NCSE  ","NCSSO ",        00303400
     1             "NCSS  ","NCPT  ","NHLDO ","NHLD  ","NHRTO ",        00303500
     2             "NHRT  ","      ","      ","      ","      " /       00303600
      DATA ILOC1 /     1,    2,   38,   74,   75,                       00303700
     1                76,   77,   78,   79,   80,                       00303800
     2                81,   82,   83,   84,   85,                       00303900
     3                86,  386,  387,  388,  688,                       00304000
     4               689,  690,  691,  692,  693,                       00304100
     5               694,  695,  696,  697,  697  /                     00304200
      DATA ILOC2 /     1, 1000, 1300, 1600, 1900,                       00304300
     1              2200, 2500, 4000, 4300, 4301,                       00304400
     2              4601, 4901, 5201, 7601,10301,                       00304500
     3             12701,15101,15401,15700,15700  /                     00304600
      DATA ILOC3 /     1, 3001, 4386, 4386, 4386  /                     00304700
      DATA ILOC4 /     1,    2,   22,   42,   62,                       00304800
     1                82,  102,  122,  142,  302,                       00304900
     2               303,  323,  383,  443,  602  /                     00305000
      DATA ILOC5 /     1,    2,   77,  152,  227,                       00305100
     1               302,  377,  452,  527,  602,                       00305200
     2               677,  752,  827,  902,  977,                       00305300
     3               978, 1028, 1078, 1128, 1178,                       00305400
     4              1179, 1229, 1279, 1328, 1328  /                     00305500
      DATA ILOC6 /     1,    7,  457,  907, 1357,                       00305600
     1              1807, 2257, 2707, 3157, 3607,                       00305700
     2              4057, 4507, 4957, 5407, 5857,                       00305800
     3              5860, 6085, 6310, 6535, 6760,                       00305900
     4              6985, 7210, 7435, 7438, 7588,                       00306000
     5              7738, 7888, 8038, 8188, 8338,                       00306100
     6              8488, 8638, 8788, 8938, 8939,                       00306200
     7              8989, 9038, 9038, 9038, 9038  /                     00306300
      DATA ILOC7 /     1,    7,  157,  307,  457,                       00306400
     1               607,  609, 3809, 3889, 3891,                       00306500
     2              5391, 6891, 8390, 8390, 8390  /                     00306600
      DATA ILOC8 /     1,  301,  601,  901, 1201,                       00306700
     1              1501, 1801, 2101, 2401, 2701,                       00306800
     2              2702, 2703, 2704, 2705, 2706,                       00306900
     3              2707, 2708, 2709, 3009, 5408  /                     00307000
      DATA ILOC9 /     1,    6, 2756, 2757, 3057,                       00307100
     1              3058, 3157, 3256, 3257, 3557,                       00307200
     2              3558, 3857, 3857, 3857, 3857  /                     00307300
C                                                                       00307400
C     READ CARDS                                                        00307500
 1000 REWIND 10                                                         00307600
      VLMIN=0.0001                                                      00307700
      DO 8000 I=1,99                                                    00307800
      ITYP=0                                                            00307900
      READ (10,100) ARY8,ARYY                                           00308000
      ENCODE(80,120,ARY4) ARYY                                          00308001
      TEST=ARY8(1)                                                      00308100
      IF (TEST.EQ.ENDM) GO TO 9000                                      00308200
      IF (TEST.EQ.SIZE) GO TO 3000                                      00308300
      IF (TEST.EQ.VFTR) GO TO 4000                                      00308400
C                                                                       00308500
C     ARRAY MODIFICATION                                                00308600
 2000 ILOC=1                                                            00308700
      JPOS=0                                                            00308701
      DO 2010 J=1,29                                                    00308800
      JLOC=ILOC1(J)                                                     00308900
      IF (TEST.EQ.NAME1(J)) GO TO 2100                                  00309000
 2010 CONTINUE                                                          00309100
      ILOC=2                                                            00309200
      DO 2020 J=1,18                                                    00309300
      JLOC=ILOC2(J)                                                     00309400
      JPOS=J                                                            00309401
      IF (TEST.EQ.NAME2(J)) GO TO 2100                                  00309500
 2020 CONTINUE                                                          00309600
      ILOC=3                                                            00309700
      DO 2030 J=1,2                                                     00309800
      JLOC=ILOC3(J)                                                     00309900
      JPOS=J                                                            00309901
      IF (TEST.EQ.NAME3(J)) GO TO 2100                                  00310000
 2030 CONTINUE                                                          00310100
      ILOC=4                                                            00310200
      DO 2040 J=1,14                                                    00310300
      JLOC=ILOC4(J)                                                     00310400
      JPOS=J                                                            00310401
      IF (TEST.EQ.NAME4(J)) GO TO 2100                                  00310500
 2040 CONTINUE                                                          00310600
      ILOC=5                                                            00310700
      DO 2050 J=1,23                                                    00310800
      JLOC=ILOC5(J)                                                     00310900
      JPOS=J                                                            00310901
      IF (TEST.EQ.NAME5(J)) GO TO 2100                                  00311000
 2050 CONTINUE                                                          00311100
      ILOC=6                                                            00311200
      DO 2060 J=1,36                                                    00311300
      JLOC=ILOC6(J)                                                     00311400
      JPOS=J                                                            00311401
      IF (TEST.EQ.NAME6(J)) GO TO 2100                                  00311500
 2060 CONTINUE                                                          00311600
      ILOC=7                                                            00311700
      DO 2070 J=1,12                                                    00311800
      JLOC=ILOC7(J)                                                     00311900
      JPOS=J                                                            00311901
      IF (TEST.EQ.NAME7(J)) GO TO 2100                                  00312000
 2070 CONTINUE                                                          00312100
      ILOC=8                                                            00312200
      DO 2080 J=1,19                                                    00312300
      JLOC=ILOC8(J)                                                     00312400
      JPOS=J                                                            00312401
      IF (TEST.EQ.NAME8(J)) GO TO 2100                                  00312500
 2080 CONTINUE                                                          00312600
      ILOC=9                                                            00312700
      DO 2090 J=1,11                                                    00312800
      JLOC=ILOC9(J)                                                     00312900
      JPOS=J                                                            00312901
      IF (TEST.EQ.NAME9(J)) GO TO 2100                                  00313000
 2090 CONTINUE                                                          00313100
      GO TO 8000                                                        00313200
 2100 DECODE(80,110,ARY4) IT,IST,IND,INC,I5,DEQ,DAD,DMP,DEX,D5,D6       00313300
 2110 IF (ILOC.LT.2.OR.JPOS.LT.1) GO TO 7000                            00313401
      IF (ILOC.NE.2) GO TO 2120                                         00313402
      IF (JPOS.LE.8) INPP(1)=100                                        00313403
      GO TO 7000                                                        00313404
 2120 IF (ILOC.NE.4) GO TO 2130                                         00313405
      IF (JPOS.LE.9) INPP(2)=100                                        00313406
      IF (JPOS.GT.9) INPP(27)=100                                       00313407
      GO TO 7000                                                        00313408
 2130 IF (ILOC.NE.5) GO TO 2140                                         00313409
      IF (JPOS.LE.13) INPP(3)=100                                       00313410
      IF (JPOS.GT.14.AND.JPOS.LE.19) INPP(4)=100                        00313411
      IF (JPOS.GT.19) INPP(5)=100                                       00313412
      GO TO 7000                                                        00313413
 2140 IF (ILOC.NE.6) GO TO 2150                                         00313414
      IF (JPOS.GT.14) GO TO 2142                                        00313415
      IN1=6+(IST-1)/75                                                  00313416
      IN2=6+(IND-1)/75                                                  00313417
      DO 2141 J=IN1,IN2                                                 00313418
      INO=J                                                             00313419
      IF (J.EQ.7) INO=8                                                 00313420
      IF (J.EQ.8) INO=10                                                00313421
      IF (J.EQ.9) INO=7                                                 00313422
      IF (J.EQ.10) INO=9                                                00313423
 2141 INPP(INO)=100                                                     00313424
      GO TO 7000                                                        00313425
 2142 IF (JPOS.GT.22) GO TO 2144                                        00313426
      IN1=12+(IST-1)/75                                                 00313427
      IN2=12+(IND-1)/75                                                 00313428
      DO 2143 J=IN1,IN2                                                 00313429
 2143 INPP(J)=100                                                       00313430
      GO TO 7000                                                        00313431
 2144 IF (JPOS.GT.33) GO TO 2146                                        00313432
      IN1=23+(IST-1)/50                                                 00313433
      IN2=23+(IND-1)/50                                                 00313434
      DO 2145 J=IN1,IN2                                                 00313435
 2145 INPP(J)=100                                                       00313436
      GO TO 7000                                                        00313437
 2146 INPP(26)=100                                                      00313438
      GO TO 7000                                                        00313439
 2150 IF (ILOC.NE.7) GO TO 2160                                         00313440
      IF (JPOS.GT.8) GO TO 2152                                         00313441
      IN1=15+(IST-1)/25                                                 00313442
      IN2=15+(IND-1)/25                                                 00313443
      DO 2151 J=IN1,IN2                                                 00313444
      INO=J                                                             00313445
      IF (INO.GT.17) INO=INO+1                                          00313446
 2151 INPP(INO)=100                                                     00313447
      GO TO 7000                                                        00313448
 2152 IN1=18+(IST-1)/750                                                00313449
      IN2=18+(IND-1)/750                                                00313450
      DO 2153 J=IN1,IN2                                                 00313451
      INO=J                                                             00313452
      IF (INO.EQ.19) INO=22                                             00313453
 2153 INPP(INO)=100                                                     00313454
      GO TO 7000                                                        00313455
 2160 IF (ILOC.NE.9) GO TO 7000                                         00313456
      IF (JPOS.GT.2) GO TO 7000                                         00313457
      IN1=29+(IST-1)/550                                                00313458
      IN2=29+(IND-1)/550                                                00313459
      DO 2161 J=IN1,IN2                                                 00313460
 2161 INPP(J)=100                                                       00313461
      GO TO 7000                                                        00313500
C                                                                       00313600
C     THICKNESS CHANGE FOR MATERIAL                                     00313700
 3000 DECODE(80,110,ARY4) IDIR,IST,IND,INC,ITYP,DEQ,DAD,DMP,DEX,D5,D6   00313800
      IT=2                                                              00314000
      ILOC=2                                                            00314100
      JLOC=1300+300*IDIR                                                00314200
      ITYP=1                                                            00314300
      IND=NSCTO                                                         00314400
      IMTT=IST                                                          00314500
      IST=1                                                             00314600
      INPP(1)=100                                                       00314601
      GO TO 7000                                                        00314700
C                                                                       00314800
C     TILE VIEW FACTOR MODIFICATIONS                                    00314900
 4000 DECODE(80,110,ARY4) IDR1,IDR2,IENC,I4,I5,D1,D2,D3,D4,D5,D6        00315000
      IDR3=IDR1+IDR2                                                    00315200
      IF (IDR3.GT.3) IDR3=6-IDR3                                        00315300
      IDR4=IDR3-IDR1                                                    00315400
      IF (IDR4.LT.0) IDR4=3+IDR4                                        00315500
      IDR5=3-IDR4                                                       00315600
      IF (IENC.LE.0) IENC=1                                             00315700
      IF (IENC.GT.2) GO TO 8000                                         00315800
      IN1=NRIO(IDR2,IENC)                                               00315900
      IN2=NRIO(IDR3,IENC)                                               00316000
      ND3=NRI(1,IDR1,IENC)                                              00316100
      NDL3=NSCTL(ND3)                                                   00316200
      IF (IDR2.EQ.1) DD3=DX(NDL3)                                       00316300
      IF (IDR2.EQ.2) DD3=DY(NDL3)                                       00316400
      IF (IDR2.EQ.3) DD3=DZ(NDL3)                                       00316500
      IF (IDR5.EQ.1) DDX=DRI(1,IDR1,IENC)                               00316600
      IF (IDR5.EQ.2) DDX=ZRI(1,IDR1,IENC)                               00316700
      IF (DDX.NE.0.0) DD3=DDX                                           00316800
      DD3=ABS(DD3)                                                      00316900
      DD32=DD3**2                                                       00317000
      IF (IDR3.EQ.1) DDA=DX(NDL3)                                       00317100
      IF (IDR3.EQ.2) DDA=DY(NDL3)                                       00317200
      IF (IDR3.EQ.3) DDA=DZ(NDL3)                                       00317300
      IF (IDR4.EQ.1) DDX=DRI(1,IDR1,IENC)                               00317400
      IF (IDR4.EQ.2) DDX=ZRI(1,IDR1,IENC)                               00317500
      IF (DDX.NE.0.0) DDA=DDX                                           00317600
      DDA=ABS(DDA)                                                      00317700
      AA3=DD3*DDA                                                       00317800
      NVF=NVFO(IENC)                                                    00317900
 4010 DO 4020 J=1,IN2                                                   00318000
      ND2=NRI(J,IDR3,IENC)                                              00318100
      NDL2=NSCTL(ND2)                                                   00318200
      IF (IDR3.EQ.1) DD0=DX(NDL2)                                       00318300
      IF (IDR3.EQ.2) DD0=DY(NDL2)                                       00318400
      IF (IDR3.EQ.3) DD0=DZ(NDL2)                                       00318500
      DD0=ABS(DD0)                                                      00318600
      IF (IDR4.EQ.1) DRI(J,IDR3,IENC)=DD0                               00318700
      IF (IDR4.EQ.2) ZRI(J,IDR3,IENC)=DD0                               00318800
 4020 CONTINUE                                                          00318900
 4100 DD1=0.0                                                           00319000
      DO 4120 J=1,IN1                                                   00319100
      ND1=NRI(J,IDR2,IENC)                                              00319200
      NDL1=NSCTL(ND1)                                                   00319300
      IF (IDR1.EQ.1) DDS=DX(NDL1)                                       00319400
      IF (IDR1.EQ.2) DDS=DY(NDL1)                                       00319500
      IF (IDR1.EQ.3) DDS=DZ(NDL1)                                       00319600
      IF (IDR4.EQ.1) DDX=DRI(J,IDR2,IENC)                               00319700
      IF (IDR4.EQ.2) DDX=ZRI(J,IDR2,IENC)                               00319800
      IF (DDX.NE.0.0) DDS=DDX                                           00319900
      DDS=ABS(DDS)                                                      00320000
      DDS2=2.0*DDS                                                      00320100
      IF (IDR3.EQ.1) DDA=DX(NDL1)                                       00320200
      IF (IDR3.EQ.2) DDA=DY(NDL1)                                       00320300
      IF (IDR3.EQ.3) DDA=DZ(NDL1)                                       00320400
      IF (IDR5.EQ.1) DDX=DRI(J,IDR2,IENC)                               00320500
      IF (IDR5.EQ.2) DDX=ZRI(J,IDR2,IENC)                               00320600
      IF (DDX.NE.0.0) DDA=DDX                                           00320700
      DDA=ABS(DDA)                                                      00320800
      AA1=DDS*DDA                                                       00320900
      DD2=0.0                                                           00321000
      DO 4110 K=1,IN2                                                   00321100
      ND2=NRI(K,IDR3,IENC)                                              00321200
      M1=LOAP(ND1,ND2,NVF,NVFI(1,IENC),NVFJ(1,IENC))                    00321300
      M2=LOAP(ND2,ND1,NVF,NVFI(1,IENC),NVFJ(1,IENC))                    00321400
      IF (IDR4.EQ.1) DDA=DRI(K,IDR3,IENC)                               00321500
      IF (IDR4.EQ.2) DDA=ZRI(K,IDR3,IENC)                               00321600
      NDL2=NSCTL(ND2)                                                   00321700
      IF (IDR1.EQ.1) DD0=DX(NDL2)                                       00321800
      IF (IDR1.EQ.2) DD0=DY(NDL2)                                       00321900
      IF (IDR1.EQ.3) DD0=DZ(NDL2)                                       00322000
      IF (IDR5.EQ.1) DDX=DRI(K,IDR3,IENC)                               00322100
      IF (IDR5.EQ.2) DDX=ZRI(K,IDR3,IENC)                               00322200
      IF (DDX.NE.0.0) DD0=DDX                                           00322300
      DD0=ABS(DD0)                                                      00322400
      DD02=2.0*DD0                                                      00322500
      AA2=DD0*DDA                                                       00322600
      DS1=DD2-DD1                                                       00322700
      S1= SQRT(DD32+DS1**2)                                             00322800
      DR1=DS1+DD0                                                       00322900
      R1= SQRT(DD32+DR1**2)                                             00323000
      DS2=(DD2+DD0)-(DD1+DDS)                                           00323100
      S2= SQRT(DD32+DS2**2)                                             00323200
      DR2=DS2-DD0                                                       00323300
      R2= SQRT(DD32+DR2**2)                                             00323400
      VALUE=((R1+R2)-(S1+S2))/DDS2                                      00323500
      VALUU=(AA1/AA2)*VALUE                                             00323600
      IF (VALUE.LT.VLMIN.AND.VALUU.LT.VLMIN) VALUE=0.0                  00323700
      IF (M1.GT.0) VFIJ(M1,IENC)=VALUE                                  00323800
      IF (M2.GT.0) VFIJ(M2,IENC)=(AA1/AA2)*VALUE                        00323900
      DD2=DD2+DD0                                                       00324000
      IF (J.NE.IN1) GO TO 4110                                          00324100
      M1=LOAP(ND2,ND3,NVF,NVFI(1,IENC),NVFJ(1,IENC))                    00324200
      M2=LOAP(ND3,ND2,NVF,NVFI(1,IENC),NVFJ(1,IENC))                    00324300
      IF ((M1+M2).EQ.0) GO TO 4110                                      00324400
      S2=(DD1+DDS)-DD2                                                  00324500
      R1=S2+DD0                                                         00324600
      S1= SQRT(DD32+R1**2)                                              00324700
      R2= SQRT(DD32+S2**2)                                              00324800
      VALUE=((R1+R2)-(S1+S2))/DD02                                      00324900
      VALUU=(AA2/AA3)*VALUE                                             00325000
      IF (VALUE.LT.VLMIN.AND.VALUU.LT.VLMIN) VALUE=0.0                  00325100
      IF (M1.GT.0) VFIJ(M1,IENC)=VALUE                                  00325200
      IF (M2.GT.0) VFIJ(M2,IENC)=(AA2/AA3)*VALUE                        00325300
 4110 CONTINUE                                                          00325400
      DD1=DD1+DDS                                                       00325500
      M1=LOAP(ND1,ND3,NVF,NVFI(1,IENC),NVFJ(1,IENC))                    00325600
      M2=LOAP(ND3,ND1,NVF,NVFI(1,IENC),NVFJ(1,IENC))                    00325700
      IF ((M1+M2).EQ.0) GO TO 4120                                      00325800
      S1=DD2-DD1                                                        00325900
      R1=S1+DDS                                                         00326000
      S2= SQRT(DD32+R1**2)                                              00326100
      R2= SQRT(DD32+S1**2)                                              00326200
      VALUE=((R1+R2)-(S1+S2))/DDS2                                      00326300
      VALUU=(AA1/AA3)*VALUE                                             00326400
      IF (VALUE.LT.VLMIN.AND.VALUU.LT.VLMIN) VALUE=0.0                  00326500
      IF (M1.GT.0) VFIJ(M1,IENC)=VALUE                                  00326600
      IF (M2.GT.0) VFIJ(M2,IENC)=(AA1/AA3)*VALUE                        00326700
 4120 CONTINUE                                                          00326800
      IENCO=14+4*IENC                                                   00326801
      INPP(IENCO)=100                                                   00326802
      GO TO 8000                                                        00326900
C                                                                       00327000
C     LOOP                                                              00327100
 7000 IF (INC.LE.0) INC=1                                               00327200
      IF (IND.LE.0) IND=IST                                             00327300
      DO 7020 J=IST,IND,INC                                             00327400
      IF (ITYP.EQ.0) GO TO 7010                                         00327500
      IF (MTLN(J).NE.IMTT) GO TO 7020                                   00327600
 7010 IJ=JLOC-1+J                                                       00327700
      IF (ILOC.EQ.1) VALUE=AR1(IJ)                                      00327800
      IF (ILOC.EQ.2) VALUE=AR2(IJ)                                      00327900
      IF (ILOC.EQ.3) VALUE=AR3(IJ)                                      00328000
      IF (ILOC.EQ.4) VALUE=AR4(IJ)                                      00328100
      IF (ILOC.EQ.5) VALUE=AR5(IJ)                                      00328200
      IF (ILOC.EQ.6) VALUE=AR6(IJ)                                      00328300
      IF (ILOC.EQ.7) VALUE=AR7(IJ)                                      00328400
      IF (ILOC.EQ.8) VALUE=AR8(IJ)                                      00328500
      IF (ILOC.EQ.9) VALUE=AR9(IJ)                                      00328600
      IF (IT.EQ.1) VALUE=IVALUE                                         00328700
      IF (ARY8(7).NE.BLK8) VALUE=DEQ                                    00328800
      VALUE=VALUE+DAD                                                   00328900
      IF (ARY8(9).NE.BLK8) VALUE=VALUE*DMP                              00329000
      IF (ARY8(10).NE.BLK8) VALUE=VALUE**DEX                            00329100
      IF (IT.EQ.1) IVALUE=VALUE                                         00329200
      IF (ILOC.EQ.1) AR1(IJ)=VALUE                                      00329300
      IF (ILOC.EQ.2) AR2(IJ)=VALUE                                      00329400
      IF (ILOC.EQ.3) AR3(IJ)=VALUE                                      00329500
      IF (ILOC.EQ.4) AR4(IJ)=VALUE                                      00329600
      IF (ILOC.EQ.5) AR5(IJ)=VALUE                                      00329700
      IF (ILOC.EQ.6) AR6(IJ)=VALUE                                      00329800
      IF (ILOC.EQ.7) AR7(IJ)=VALUE                                      00329900
      IF (ILOC.EQ.8) AR8(IJ)=VALUE                                      00330000
      IF (ILOC.EQ.9) AR9(IJ)=VALUE                                      00330100
 7020 CONTINUE                                                          00330200
C                                                                       00330300
C     END OF CARDS                                                      00330400
 8000 CONTINUE                                                          00330500
C                                                                       00330600
C     EXIT                                                              00330700
 9000 RETURN                                                            00330800
      END                                                               00330900
*DECK BDRY                                                              00330901
C     SUBROUTINE BDRY OF PROGRAM XF0031                                 00331000
C     L.W. FESLER     41-383/530  X4263                                 00331100
C                                                                       00331200
C                *****      *****      *****      *****                 00331300
C                                                                       00331400
C     THIS SUBROUTINE READS THE BOUNDARY DATA AND PRINTS THE            00331500
C     BOUNDARY DATA.                                                    00331600
C                                                                       00331700
C                *****      *****      *****      *****                 00331800
C                                                                       00331900
      SUBROUTINE BDRY                                                   00332000
C                                                                       00332100
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00332200
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00332300
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00332400
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00332500
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00332600
     5              ICLOCK,IDOMT,INPP(33)                               00332601
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00332700
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00332800
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00332900
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00333000
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00333100
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00333200
     I              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00333300
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00333400
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00333500
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00333600
     3              FP(75,3,2),BQA(75,3,2),                             00333700
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00333800
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00333900
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00334000
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00334100
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00334200
      COMMON /CMN7/ NRIO(3,2),NRI(25,3,2),ERI(25,3,2),DRI(25,3,2),      00334300
     1              ZRI(25,3,2),NAVT(2),BVT(40,40,2),NBVT(40,2),        00334400
     2              NVFO(2),NVFI(750,2),NVFJ(750,2),VFIJ(750,2),SFAS(2) 00334500
      COMMON /CMNP/ AAA(12)                                             00334501
C                                                                       00334600
      DIMENSION DATA(20)                                                00334700
C                                                                       00334800
      DATA IBLK / 77777777777777777777B /                               00334900
C                                                                       00335000
  100 FORMAT(1H15X,"HEAT FLUX DATA",I2,3X,"--AREA YZ--"/1H 5X,          00335100
     1"NCASE",I4///1H 5X,"NAOX",I1,"=",I4//1H 5X,"NAX",I1,5X,           00335200
     2"FAX",I1,6X,"QAX",I1,4X,"AAX",I1,4X,"YAX",I1,4X,"ZAX",I1,         00335300
     32X,"ITAX",I1,6X,"HRX",I1,5X,"FRX",I1,6X,"TRX",I1,6X,              00335400
     4"PRX",I1,5X,"FPX",I1)                                             00335500
  101 FORMAT(12A10)                                                     00335501
  110 FORMAT(1H15X,"HEAT FLUX DATA",I2,3X,"--AREA ZX--"/1H 5X,          00335600
     1"NCASE",I4///1H 5X,"NAOY",I1,"=",I4//1H 5X,"NAY",I1,5X,           00335700
     2"FAY",I1,6X,"QAY",I1,4X,"AAY",I1,4X,"ZAY",I1,4X,"XAY",I1,         00335800
     32X,"ITAY",I1,6X,"HRY",I1,5X,"FRY",I1,6X,"TRY",I1,6X,              00335900
     4"PRY",I1,5X,"FPY",I1)                                             00336000
  120 FORMAT(1H15X,"HEAT FLUX DATA",I2,3X,"--AREA XY--"/1H 5X,          00336100
     1"NCASE",I4///1H 5X,"NAOZ",I1,"=",I4//1H 5X,"NAZ",I1,5X,           00336200
     2"FAZ",I1,6X,"QAZ",I1,4X,"AAZ",I1,4X,"XAZ",I1,4X,"YAZ",I1,         00336300
     32X,"ITAZ",I1,6X,"HRZ",I1,5X,"FRZ",I1,6X,"TRZ",I1,6X,              00336400
     4"PRZ",I1,5X,"FPZ",I1)                                             00336500
  130 FORMAT(6(1H ),I4,F9.3,F10.3,F8.2,83(1H ))                         00336600
  200 FORMAT(1H15X,"RERADIATION DATA   --AREA YZ--"/1H 5X,              00336700
     1"NCASE",I4///1H 5X,"NRSOX=",I4//1H 5X,"NRSX",8X,"FRSX",8X,        00336800
     2"ERSX",8X,"TRSX",8X,"YRSX",8X,"ZRSX")                             00336900
  210 FORMAT(1H15X,"RERADIATION DATA   --AREA ZX--"/1H 5X,              00337000
     1"NCASE",I4///1H 5X,"NRSOY=",I4//1H 5X,"NRSY",8X,"FRSY",8X,        00337100
     2"ERSY",8X,"TRSY",8X,"ZRSY",8X,"XRSY")                             00337200
  220 FORMAT(1H15X,"RERADIATION DATA   --AREA XY--"/1H 5X,              00337300
     1"NCASE",I4///1H 5X,"NRSOZ=",I4//1H 5X,"NRSZ",8X,"FRSZ",8X,        00337400
     2"ERSZ",8X,"TRSZ",8X,"XRSZ",8X,"YRSZ")                             00337500
  230 FORMAT(6(1H ),I4,F12.4,2F12.3,74(1H ))                            00337600
  300 FORMAT(1H15X,"RADIATION INTERCHANGE DATA",I2,3X,"--AREA YZ--"/    00337700
     11H 5X,"NCASE",I4///1H 5X,"NRIOX",I1,"=",I4//                      00337800
     21H 5X,"NRIX",I1,7X,"ERIX",I1,7X,"YRIX",I1,7X,"ZRIX",I1)           00337900
  310 FORMAT(1H15X,"RADIATION INTERCHANGE DATA",I2,3X,"--AREA ZX--"/    00338000
     11H 5X,"NCASE",I4///1H 5X,"NRIOY",I1,"=",I4//                      00338100
     21H 5X,"NRIY",I1,7X,"ERIY",I1,7X,"ZRIY",I1,7X,"XRIY",I1)           00338200
  320 FORMAT(1H15X,"RADIATION INTERCHANGE DATA",I2,3X,"--AREA XY--"/    00338300
     11H 5X,"NCASE",I4///1H 5X,"NRIOZ",I1,"=",I4//                      00338400
     21H 5X,"NRIZ",I1,7X,"ERIZ",I1,7X,"XRIZ",I1,7X,"YRIZ",I1)           00338500
  330 FORMAT(6(1H ),I5,F12.3,97(1H ))                                   00338600
  340 FORMAT(1H15X,"RADIATION INTERCHANGE DATA",I2,3X,                  00338700
     1"--VIEW FACTORS--"/1H 5X,"NCASE",I4///                            00338800
     21H 5X,"NVFO",I1,"=",I4//1H 5X,"NVFI",I1,5X,"NVFJ",I1,7X,          00338900
     3"VFIJ",I1/(1H 5X,I5,I10,F12.4))                                   00339000
  400 FORMAT(1H15X,"CONVECTION DATA   --AREA YZ--"/1H 5X,               00339100
     1"NCASE",I4///1H 5X,"NCOX=",I4//1H 5X," NCX",9X,"FCX",9X,          00339200
     2"HCX",9X,"TCX",9X,"YCX",9X,"ZCX",6X,"ITCX",6X,"NCIX",6X,"NCJX")   00339300
  410 FORMAT(1H15X,"CONVECTION DATA   --AREA ZX--"/1H 5X,               00339400
     1"NCASE",I4///1H 5X,"NCOY=",I4//1H 5X," NCY",9X,"FCY",9X,          00339500
     2"HCY",9X,"TCY",9X,"ZCY",9X,"XCY",6X,"ITCY",6X,"NCIY",6X,"NCJY")   00339600
  420 FORMAT(1H15X,"CONVECTION DATA   --AREA XY--"/1H 5X,               00339700
     1"NCASE",I4///1H 5X,"NCOZ=",I4//1H 5X," NCZ",9X,"FCZ",9X,          00339800
     2"HCZ",9X,"TCZ",9X,"XCZ",9X,"YCZ",6X,"ITCZ",6X,"NCIZ",6X,"NCJZ")   00339900
  430 FORMAT(6(1H ),I4,2F12.4,86(1H ))                                  00340000
  440 FORMAT(6(1H ),I4,2F12.4,F12.3,74(1H ))                            00340100
  500 FORMAT(1H15X,"KNOWN TEMPERATURE DATA"/1H 5X,"NCASE",I4///         00340200
     11H 5X,"NKTO=",I4//1H 5X," NKT",8X,"TNKT",6X,"INKT")               00340300
  510 FORMAT(6(1H ),I4,110(1H ))                                        00340400
C                                                                       00340500
C     HEAT FLUX DATA                                                    00340600
 1000 NAOO=0                                                            00340700
      IPNT=IABS(INPO(35))                                               00340701
      IF (NCASE.EQ.1) IPNT=1                                            00340702
      DO 1290 IN2=1,3                                                   00340800
      DO 1290 IN1=1,2                                                   00340900
      IN=2*(IN2-1)+IN1                                                  00341000
      INO=5+IN                                                          00341100
      IF (NCASE.EQ.1) GO TO 1100                                        00341200
      IF (INPO(INO).EQ.0) NAO(IN2,IN1)=0                                00341300
      IF (IDLTO.EQ.0) GO TO 1100                                        00341400
      NW=NAO(IN2,IN1)                                                   00341500
      IF (NW.EQ.0) GO TO 1100                                           00341600
      DO 1040 I=1,NW                                                    00341700
 1005 IF (I.GT.NAO(IN2,IN1)) GO TO 1100                                 00341800
      M=NA(I,IN2,IN1)                                                   00341900
      DO 1010 J=1,IDLTO                                                 00342000
      IF (IDLT(J).EQ.M) GO TO 1020                                      00342100
 1010 CONTINUE                                                          00342200
      GO TO 1040                                                        00342300
 1020 NAO(IN2,IN1)=NAO(IN2,IN1)-1                                       00342400
      NAI=NAO(IN2,IN1)                                                  00342500
      IF (NAI.EQ.0) GO TO 1100                                          00342600
      NI=I                                                              00342700
      IF (NI.GT.NAI) GO TO 1040                                         00342800
      DO 1030 J=NI,NAI                                                  00342900
      JS=J+1                                                            00343000
      NA(J,IN2,IN1)=NA(JS,IN2,IN1)                                      00343100
      FA(J,IN2,IN1)=FA(JS,IN2,IN1)                                      00343200
      QA(J,IN2,IN1)=QA(JS,IN2,IN1)                                      00343300
      AA(J,IN2,IN1)=AA(JS,IN2,IN1)                                      00343400
      DA(J,IN2,IN1)=DA(JS,IN2,IN1)                                      00343500
      ZA(J,IN2,IN1)=ZA(JS,IN2,IN1)                                      00343600
      HR(J,IN2,IN1)=HR(JS,IN2,IN1)                                      00343700
      FR(J,IN2,IN1)=FR(JS,IN2,IN1)                                      00343800
      TR(J,IN2,IN1)=TR(JS,IN2,IN1)                                      00343900
      PR(J,IN2,IN1)=PR(JS,IN2,IN1)                                      00344000
      FP(J,IN2,IN1)=FP(JS,IN2,IN1)                                      00344100
 1030 ITA(J,IN2,IN1)=ITA(JS,IN2,IN1)                                    00344200
      GO TO 1005                                                        00344300
 1040 CONTINUE                                                          00344400
 1100 IF (INRO(INO).NE.1) GO TO 1200                                    00344500
      ICD=ICRD(1,7,DATA)                                                00344600
      NW=DATA(1)                                                        00344700
      IF (NW.EQ.0) GO TO 1200                                           00344800
      DO 1150 I=1,NW                                                    00344900
      ICD=ICRD(12,7,DATA)                                               00345000
      IF (ICD.EQ.8) GO TO 1200                                          00345100
      N=DATA(1)                                                         00345200
      IF (N.EQ.0) GO TO 1150                                            00345300
      NI=LONP(N,NAO(IN2,IN1),NA(1,IN2,IN1))                             00345400
      IF (N.GT.0) GO TO 1130                                            00345500
      IF (NI.EQ.0) GO TO 1150                                           00345600
 1110 NAO(IN2,IN1)=NAO(IN2,IN1)-1                                       00345700
      NAI=NAO(IN2,IN1)                                                  00345800
      IF (NI.GT.NAI) GO TO 1150                                         00345900
      DO 1120 J=NI,NAI                                                  00346000
      JS=J+1                                                            00346100
      NA(J,IN2,IN1)=NA(JS,IN2,IN1)                                      00346200
      FA(J,IN2,IN1)=FA(JS,IN2,IN1)                                      00346300
      QA(J,IN2,IN1)=QA(JS,IN2,IN1)                                      00346400
      AA(J,IN2,IN1)=AA(JS,IN2,IN1)                                      00346500
      DA(J,IN2,IN1)=DA(JS,IN2,IN1)                                      00346600
      ZA(J,IN2,IN1)=ZA(JS,IN2,IN1)                                      00346700
      HR(J,IN2,IN1)=HR(JS,IN2,IN1)                                      00346800
      FR(J,IN2,IN1)=FR(JS,IN2,IN1)                                      00346900
      TR(J,IN2,IN1)=TR(JS,IN2,IN1)                                      00347000
      PR(J,IN2,IN1)=PR(JS,IN2,IN1)                                      00347100
      FP(J,IN2,IN1)=FP(JS,IN2,IN1)                                      00347200
 1120 ITA(J,IN2,IN1)=ITA(JS,IN2,IN1)                                    00347300
      GO TO 1150                                                        00347400
 1130 IB=2                                                              00347500
      IF (NI.GT.0) GO TO 1140                                           00347600
      NAO(IN2,IN1)=NAO(IN2,IN1)+1                                       00347700
      NI=NAO(IN2,IN1)                                                   00347800
      IB=1                                                              00347900
 1140 IF (NCASE.EQ.1) IB=1                                              00348000
      NA(NI,IN2,IN1)=N                                                  00348100
      M=MSTD(IB,2,2,0,0,FA(NI,IN2,IN1),DATA(2))                         00348200
      M=MSTD(IB,2,2,0,0,QA(NI,IN2,IN1),DATA(3))                         00348300
      M=MSTD(IB,2,2,0,0,AA(NI,IN2,IN1),DATA(4))                         00348400
      IF (AA(NI,IN2,IN1).EQ.0.0) AA(NI,IN2,IN1)=1.0                     00348500
      M=MSTD(IB,2,2,0,0,DA(NI,IN2,IN1),DATA(5))                         00348600
      M=MSTD(IB,2,2,0,0,ZA(NI,IN2,IN1),DATA(6))                         00348700
      M=MSTD(IB,2,2,0,0,HR(NI,IN2,IN1),DATA(8))                         00348800
      M=MSTD(IB,2,2,0,0,FR(NI,IN2,IN1),DATA(9))                         00348900
      M=MSTD(IB,2,2,0,0,TR(NI,IN2,IN1),DATA(10))                        00349000
      M=MSTD(IB,2,2,0,0,PR(NI,IN2,IN1),DATA(11))                        00349100
      M=MSTD(IB,2,2,0,0,FP(NI,IN2,IN1),DATA(12))                        00349200
      M=MSTD(IB,1,2,ITA(NI,IN2,IN1),0,0.0,DATA(7))                      00349300
      IF (ITA(NI,IN2,IN1).EQ.0) ITA(NI,IN2,IN1)=IBLK                    00349400
 1150 CONTINUE                                                          00349500
 1200 IF (INPO(INO).NE.1) GO TO 1290                                    00349600
      NAI=NAO(IN2,IN1)                                                  00349700
      IF (NAI.EQ.0) GO TO 1290                                          00349800
      NAOO=NAOO+1                                                       00349900
      IF (IPNT.GT.99.AND.INPP(INO).LE.1) GO TO 1290                     00349901
 1210 IF (IN2.EQ.1) WRITE (6,100) IN1,NCASE,IN1,NAI,IN1,IN1,            00350000
     1IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1                           00350100
      IF (IN2.EQ.2) WRITE (6,110) IN1,NCASE,IN1,NAI,IN1,IN1,            00350200
     1IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1                           00350300
      IF (IN2.EQ.3) WRITE (6,120) IN1,NCASE,IN1,NAI,IN1,IN1,            00350400
     1IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1,IN1                           00350500
      DO 1220 I=1,NAI                                                   00350600
      ENCODE(120,130,AAA) NA(I,IN2,IN1),FA(I,IN2,IN1),QA(I,IN2,IN1),    00350700
     1AA(I,IN2,IN1)                                                     00350800
      M=MPTD(2,36,8,2,0,DA(I,IN2,IN1))                                  00350900
      M=MPTD(2,44,8,2,0,ZA(I,IN2,IN1))                                  00351000
      M=MPTD(1,52,7,0,ITA(I,IN2,IN1),0.0)                               00351100
      M=MPTD(2,59,10,4,0,HR(I,IN2,IN1))                                 00351200
      M=MPTD(2,69,9,3,0,FR(I,IN2,IN1))                                  00351300
      M=MPTD(2,78,10,3,0,TR(I,IN2,IN1))                                 00351400
      M=MPTD(2,88,10,3,0,PR(I,IN2,IN1))                                 00351500
      M=MPTD(2,98,9,3,0,FP(I,IN2,IN1))                                  00351600
      WRITE (6,101) AAA                                                 00351601
 1220 CONTINUE                                                          00351700
 1290 CONTINUE                                                          00351800
C                                                                       00351900
C     RERADIATION DATA                                                  00352000
 2000 NRSOO=0                                                           00352100
      DO 2290 IN=1,3                                                    00352200
      INO=11+IN                                                         00352300
      IF (NCASE.EQ.1) GO TO 2100                                        00352400
      IF (INPO(INO).EQ.0) NRSO(IN)=0                                    00352500
      IF (IDLTO.EQ.0) GO TO 2100                                        00352600
      NW=NRSO(IN)                                                       00352700
      IF (NW.EQ.0) GO TO 2100                                           00352800
      DO 2040 I=1,NW                                                    00352900
 2005 IF (I.GT.NRSO(IN)) GO TO 2100                                     00353000
      M=NRS(I,IN)                                                       00353100
      DO 2010 J=1,IDLTO                                                 00353200
      IF (IDLT(J).EQ.M) GO TO 2020                                      00353300
 2010 CONTINUE                                                          00353400
      GO TO 2040                                                        00353500
 2020 NRSO(IN)=NRSO(IN)-1                                               00353600
      NRSI=NRSO(IN)                                                     00353700
      IF (NRSI.EQ.0) GO TO 2100                                         00353800
      NI=I                                                              00353900
      IF (NI.GT.NRSI) GO TO 2040                                        00354000
      DO 2030 J=NI,NRSI                                                 00354100
      JS=J+1                                                            00354200
      NRS(J,IN)=NRS(JS,IN)                                              00354300
      FRS(J,IN)=FRS(JS,IN)                                              00354400
      ERS(J,IN)=ERS(JS,IN)                                              00354500
      TRS(J,IN)=TRS(JS,IN)                                              00354600
      DRS(J,IN)=DRS(JS,IN)                                              00354700
 2030 ZRS(J,IN)=ZRS(JS,IN)                                              00354800
      GO TO 2005                                                        00354900
 2040 CONTINUE                                                          00355000
 2100 IF (INRO(INO).NE.1) GO TO 2200                                    00355100
      ICD=ICRD(1,8,DATA)                                                00355200
      NW=DATA(1)                                                        00355300
      IF (NW.EQ.0) GO TO 2200                                           00355400
      DO 2150 I=1,NW                                                    00355500
      ICD=ICRD(6,8,DATA)                                                00355600
      IF (ICD.EQ.8) GO TO 2200                                          00355700
      N=DATA(1)                                                         00355800
      IF (N.EQ.0) GO TO 2150                                            00355900
      NI=LONP(N,NRSO(IN),NRS(1,IN))                                     00356000
      IF (N.GT.0) GO TO 2130                                            00356100
      IF (NI.EQ.0) GO TO 2150                                           00356200
 2110 NRSO(IN)=NRSO(IN)-1                                               00356300
      NRSI=NRSO(IN)                                                     00356400
      IF (NI.GT.NRSI) GO TO 2150                                        00356500
      DO 2120 J=NI,NRSI                                                 00356600
      JS=J+1                                                            00356700
      NRS(J,IN)=NRS(JS,IN)                                              00356800
      FRS(J,IN)=FRS(JS,IN)                                              00356900
      ERS(J,IN)=ERS(JS,IN)                                              00357000
      TRS(J,IN)=TRS(JS,IN)                                              00357100
      DRS(J,IN)=DRS(JS,IN)                                              00357200
 2120 ZRS(J,IN)=ZRS(JS,IN)                                              00357300
      GO TO 2150                                                        00357400
 2130 IB=2                                                              00357500
      IF (NI.GT.0) GO TO 2140                                           00357600
      NRSO(IN)=NRSO(IN)+1                                               00357700
      NI=NRSO(IN)                                                       00357800
      IB=1                                                              00357900
 2140 IF (NCASE.EQ.1) IB=1                                              00358000
      NRS(NI,IN)=N                                                      00358100
      M=MSTD(IB,2,2,0,0,FRS(NI,IN),DATA(2))                             00358200
      M=MSTD(IB,2,2,0,0,ERS(NI,IN),DATA(3))                             00358300
      M=MSTD(IB,2,2,0,0,TRS(NI,IN),DATA(4))                             00358400
      M=MSTD(IB,2,2,0,0,DRS(NI,IN),DATA(5))                             00358500
      M=MSTD(IB,2,2,0,0,ZRS(NI,IN),DATA(6))                             00358600
 2150 CONTINUE                                                          00358700
 2200 IF (INPO(INO).NE.1) GO TO 2290                                    00358800
      NRSI=NRSO(IN)                                                     00358900
      IF (NRSI.EQ.0) GO TO 2290                                         00359000
      NRSOO=NRSOO+1                                                     00359100
      IF (IPNT.GT.99.AND.INPP(INO).LE.1) GO TO 2290                     00359101
 2210 IF (IN.EQ.1) WRITE (6,200) NCASE,NRSI                             00359200
      IF (IN.EQ.2) WRITE (6,210) NCASE,NRSI                             00359300
      IF (IN.EQ.3) WRITE (6,220) NCASE,NRSI                             00359400
      DO 2220 I=1,NRSI                                                  00359500
      ENCODE(120,230,AAA) NRS(I,IN),FRS(I,IN),ERS(I,IN),TRS(I,IN)       00359600
      M=MPTD(2,45,12,3,0,DRS(I,IN))                                     00359700
      M=MPTD(2,57,12,3,0,ZRS(I,IN))                                     00359800
      WRITE (6,101) AAA                                                 00359801
 2220 CONTINUE                                                          00359900
 2290 CONTINUE                                                          00360000
C                                                                       00360100
C     RADIATION INTERCHANGE DATA                                        00360200
 3000 NRIOO=0                                                           00360300
      DO 3590 IN1=1,2                                                   00360400
      DO 3290 IN2=1,3                                                   00360500
      IN=4*(IN1-1)+IN2                                                  00360600
      INO=14+IN                                                         00360700
      IF (NCASE.EQ.1) GO TO 3100                                        00360800
      IF (INPO(INO).EQ.0) NRIO(IN2,IN1)=0                               00360900
      IF (IDLTO.EQ.0) GO TO 3100                                        00361000
      NW=NRIO(IN2,IN1)                                                  00361100
      IF (NW.EQ.0) GO TO 3100                                           00361200
      DO 3040 I=1,NW                                                    00361300
 3005 IF (I.GT.NRIO(IN2,IN1)) GO TO 3100                                00361400
      M=NRI(I,IN2,IN1)                                                  00361500
      DO 3010 J=1,IDLTO                                                 00361600
      IF (IDLT(J).EQ.M) GO TO 3020                                      00361700
 3010 CONTINUE                                                          00361800
      GO TO 3040                                                        00361900
 3020 NRIO(IN2,IN1)=NRIO(IN2,IN1)-1                                     00362000
      NRII=NRIO(IN2,IN1)                                                00362100
      IF (NRII.EQ.0) GO TO 3100                                         00362200
      NI=I                                                              00362300
      IF (NI.GT.NRII) GO TO 3040                                        00362400
      DO 3030 J=NI,NRII                                                 00362500
      JS=J+1                                                            00362600
      NRI(J,IN2,IN1)=NRI(JS,IN2,IN1)                                    00362700
      ERI(J,IN2,IN1)=ERI(JS,IN2,IN1)                                    00362800
      DRI(J,IN2,IN1)=DRI(JS,IN2,IN1)                                    00362900
 3030 ZRI(J,IN2,IN1)=ZRI(JS,IN2,IN1)                                    00363000
      GO TO 3005                                                        00363100
 3040 CONTINUE                                                          00363200
 3100 IF (INRO(INO).NE.1) GO TO 3200                                    00363300
      ICD=ICRD(1,9,DATA)                                                00363400
      NW=DATA(1)                                                        00363500
      IF (NW.EQ.0) GO TO 3200                                           00363600
      DO 3150 I=1,NW                                                    00363700
      ICD=ICRD(4,9,DATA)                                                00363800
      IF (ICD.EQ.8) GO TO 3200                                          00363900
      N=DATA(1)                                                         00364000
      IF (N.EQ.0) GO TO 3150                                            00364100
      NI=LONP(N,NRIO(IN2,IN1),NRI(1,IN2,IN1))                           00364200
      IF (N.GT.0) GO TO 3130                                            00364300
      IF (NI.EQ.0) GO TO 3150                                           00364400
 3110 NRIO(IN2,IN1)=NRIO(IN2,IN1)-1                                     00364500
      NRII=NRIO(IN2,IN1)                                                00364600
      IF (NI.GT.NRII) GO TO 3150                                        00364700
      DO 3120 J=NI,NRII                                                 00364800
      JS=J+1                                                            00364900
      NRI(J,IN2,IN1)=NRI(JS,IN2,IN1)                                    00365000
      ERI(J,IN2,IN1)=ERI(JS,IN2,IN1)                                    00365100
      DRI(J,IN2,IN1)=DRI(JS,IN2,IN1)                                    00365200
 3120 ZRI(J,IN2,IN1)=ZRI(JS,IN2,IN1)                                    00365300
      GO TO 3150                                                        00365400
 3130 IB=2                                                              00365500
      IF (NI.GT.0) GO TO 3140                                           00365600
      NRIO(IN2,IN1)=NRIO(IN2,IN1)+1                                     00365700
      NI=NRIO(IN2,IN1)                                                  00365800
      IB=1                                                              00365900
 3140 IF (NCASE.EQ.1) IB=1                                              00366000
      NRI(NI,IN2,IN1)=N                                                 00366100
      M=MSTD(IB,2,2,0,0,ERI(NI,IN2,IN1),DATA(2))                        00366200
      M=MSTD(IB,2,2,0,0,DRI(NI,IN2,IN1),DATA(3))                        00366300
      M=MSTD(IB,2,2,0,0,ZRI(NI,IN2,IN1),DATA(4))                        00366400
 3150 CONTINUE                                                          00366500
 3200 IF (INPO(INO).NE.1) GO TO 3290                                    00366600
      NRII=NRIO(IN2,IN1)                                                00366700
      IF (NRII.EQ.0) GO TO 3290                                         00366800
      NRIOO=NRIOO+1                                                     00366900
      IF (IPNT.GT.99.AND.INPP(INO).LE.1) GO TO 3290                     00366901
 3210 IF (IN2.EQ.1) WRITE (6,300) IN1,NCASE,IN1,NRII,IN1,IN1,IN1,IN1    00367000
      IF (IN2.EQ.2) WRITE (6,310) IN1,NCASE,IN1,NRII,IN1,IN1,IN1,IN1    00367100
      IF (IN2.EQ.3) WRITE (6,320) IN1,NCASE,IN1,NRII,IN1,IN1,IN1,IN1    00367200
      DO 3220 I=1,NRII                                                  00367300
      ENCODE(120,330,AAA) NRI(I,IN2,IN1),ERI(I,IN2,IN1)                 00367400
      M=MPTD(2,22,12,3,0,DRI(I,IN2,IN1))                                00367500
      M=MPTD(2,34,12,3,0,ZRI(I,IN2,IN1))                                00367600
      WRITE (6,101) AAA                                                 00367601
 3220 CONTINUE                                                          00367700
 3290 CONTINUE                                                          00367800
 3300 IF (NCASE.EQ.1) GO TO 3400                                        00367900
      IF (INPO(INO+1).EQ.0) NVFO(IN1)=0                                 00368000
      IF (IDLTO.EQ.0) GO TO 3400                                        00368100
      NW=NVFO(IN1)                                                      00368200
      IF (NW.EQ.0) GO TO 3400                                           00368300
      DO 3340 I=1,NW                                                    00368400
 3305 IF (I.GT.NVFO(IN1)) GO TO 3400                                    00368500
      MI=NVFI(I,IN1)                                                    00368600
      MJ=NVFJ(I,IN1)                                                    00368700
      DO 3310 J=1,IDLTO                                                 00368800
      IF (IDLT(J).EQ.MI) GO TO 3320                                     00368900
      IF (IDLT(J).EQ.MJ) GO TO 3320                                     00369000
 3310 CONTINUE                                                          00369100
      GO TO 3340                                                        00369200
 3320 NVFO(IN1)=NVFO(IN1)-1                                             00369300
      NVOI=NVFO(IN1)                                                    00369400
      IF (NVOI.EQ.0) GO TO 3400                                         00369500
      NI=I                                                              00369600
      IF (NI.GT.NVOI) GO TO 3340                                        00369700
      DO 3330 J=NI,NVOI                                                 00369800
      JS=J+1                                                            00369900
      NVFI(J,IN1)=NVFI(JS,IN1)                                          00370000
      NVFJ(J,IN1)=NVFJ(JS,IN1)                                          00370100
 3330 VFIJ(J,IN1)=VFIJ(JS,IN1)                                          00370200
      GO TO 3305                                                        00370300
 3340 CONTINUE                                                          00370400
 3400 IF (INRO(INO+1).NE.1) GO TO 3500                                  00370500
      ICD=ICRD(1,9,DATA)                                                00370600
      NW=DATA(1)                                                        00370700
      SFAS(IN1)=DATA(3)                                                 00370800
      IF (NW.EQ.0) GO TO 3500                                           00370900
      DO 3450 I=1,NW                                                    00371000
      ICD=ICRD(3,9,DATA)                                                00371100
      IF (ICD.EQ.8) GO TO 3500                                          00371200
      N=DATA(1)                                                         00371300
      IF (N.EQ.0) GO TO 3450                                            00371400
      NJ=DATA(2)                                                        00371500
      NI=LOAP(N,NJ,NVFO(IN1),NVFI(1,IN1),NVFJ(1,IN1))                   00371600
      IF (N.GT.0) GO TO 3430                                            00371700
      IF (NI.EQ.0) GO TO 3450                                           00371800
 3410 NVFO(IN1)=NVFO(IN1)-1                                             00371900
      NVOI=NVFO(IN1)                                                    00372000
      IF (NI.GT.NVOI) GO TO 3450                                        00372100
      DO 3420 J=NI,NVOI                                                 00372200
      JS=J+1                                                            00372300
      NVFI(J,IN1)=NVFI(JS,IN1)                                          00372400
      NVFJ(J,IN1)=NVFJ(JS,IN1)                                          00372500
 3420 VFIJ(J,IN1)=VFIJ(JS,IN1)                                          00372600
      GO TO 3450                                                        00372700
 3430 IB=2                                                              00372800
      IF (NI.GT.0) GO TO 3440                                           00372900
      NVFO(IN1)=NVFO(IN1)+1                                             00373000
      NI=NVFO(IN1)                                                      00373100
      IB=1                                                              00373200
 3440 IF (NCASE.EQ.1) IB=1                                              00373300
      NVFI(NI,IN1)=N                                                    00373400
      M=MSTD(IB,1,2,NVFJ(NI,IN1),0,0.0,DATA(2))                         00373500
      M=MSTD(IB,2,2,0,0,VFIJ(NI,IN1),DATA(3))                           00373600
 3450 CONTINUE                                                          00373700
 3500 IF (INPO(INO+1).NE.1) GO TO 3590                                  00373800
      IF (IPNT.GT.99.AND.INPP(INO+1).LE.1) GO TO 3590                   00373801
      NVOI=NVFO(IN1)                                                    00373900
      IF (NVOI.GT.0) GO TO 3510                                         00374000
 3510 WRITE (6,340) IN1,NCASE,IN1,NVOI,IN1,IN1,IN1,                     00374100
     1(NVFI(I,IN1),NVFJ(I,IN1),VFIJ(I,IN1),I=1,NVOI)                    00374200
 3590 CONTINUE                                                          00374300
C                                                                       00374400
C     CONVECTION DATA                                                   00374500
 4000 NCOO=0                                                            00374600
      DO 4290 IN=1,3                                                    00374700
      INO=22+IN                                                         00374800
      IF (NCASE.EQ.1) GO TO 4100                                        00374900
      IF (INPO(INO).EQ.0) NCO(IN)=0                                     00375000
      IF (IDLTO.EQ.0) GO TO 4100                                        00375100
      NW=NCO(IN)                                                        00375200
      IF (NW.EQ.0) GO TO 4100                                           00375300
      DO 4040 I=1,NW                                                    00375400
 4005 IF (I.GT.NCO(IN)) GO TO 4100                                      00375500
      M=NC(I,IN)                                                        00375600
      DO 4010 J=1,IDLTO                                                 00375700
      IF (IDLT(J).EQ.M) GO TO 4020                                      00375800
 4010 CONTINUE                                                          00375900
      GO TO 4040                                                        00376000
 4020 NCO(IN)=NCO(IN)-1                                                 00376100
      NCOI=NCO(IN)                                                      00376200
      IF (NCOI.EQ.0) GO TO 4100                                         00376300
      NI=I                                                              00376400
      IF (NI.GT.NCOI) GO TO 4040                                        00376500
      DO 4030 J=NI,NCOI                                                 00376600
      JS=J+1                                                            00376700
      NC(J,IN)=NC(JS,IN)                                                00376800
      FC(J,IN)=FC(JS,IN)                                                00376900
      HC(J,IN)=HC(JS,IN)                                                00377000
      TC(J,IN)=TC(JS,IN)                                                00377100
      DC(J,IN)=DC(JS,IN)                                                00377200
      ZC(J,IN)=ZC(JS,IN)                                                00377300
      ITC(J,IN)=ITC(JS,IN)                                              00377400
      NCI(J,IN)=NCI(JS,IN)                                              00377500
 4030 NCJ(J,IN)=NCJ(JS,IN)                                              00377600
      GO TO 4005                                                        00377700
 4040 CONTINUE                                                          00377800
 4100 IF (INRO(INO).NE.1) GO TO 4200                                    00377900
      ICD=ICRD(1,10,DATA)                                               00378000
      NW=DATA(1)                                                        00378100
      IF (NW.EQ.0) GO TO 4200                                           00378200
      DO 4150 I=1,NW                                                    00378300
      ICD=ICRD(9,10,DATA)                                               00378400
      IF (ICD.EQ.8) GO TO 4200                                          00378500
      N=DATA(1)                                                         00378600
      IF (N.EQ.0) GO TO 4150                                            00378700
      NI=LONP(N,NCO(IN),NC(1,IN))                                       00378800
      IF (N.GT.0) GO TO 4130                                            00378900
      IF (NI.EQ.0) GO TO 4150                                           00379000
 4110 NCO(IN)=NCO(IN)-1                                                 00379100
      NCOI=NCO(IN)                                                      00379200
      IF (NI.GT.NCOI) GO TO 4150                                        00379300
      DO 4120 J=NI,NCOI                                                 00379400
      JS=J+1                                                            00379500
      NC(J,IN)=NC(JS,IN)                                                00379600
      FC(J,IN)=FC(JS,IN)                                                00379700
      HC(J,IN)=HC(JS,IN)                                                00379800
      TC(J,IN)=TC(JS,IN)                                                00379900
      DC(J,IN)=DC(JS,IN)                                                00380000
      ZC(J,IN)=ZC(JS,IN)                                                00380100
      ITC(J,IN)=ITC(JS,IN)                                              00380200
      NCI(J,IN)=NCI(JS,IN)                                              00380300
 4120 NCJ(J,IN)=NCJ(JS,IN)                                              00380400
      GO TO 4150                                                        00380500
 4130 IB=2                                                              00380600
      IF (NI.GT.0) GO TO 4140                                           00380700
      NCO(IN)=NCO(IN)+1                                                 00380800
      NI=NCO(IN)                                                        00380900
      IB=1                                                              00381000
 4140 IF (NCASE.EQ.1) IB=1                                              00381100
      NC(NI,IN)=N                                                       00381200
      M=MSTD(IB,2,2,0,0,FC(NI,IN),DATA(2))                              00381300
      M=MSTD(IB,2,2,0,0,HC(NI,IN),DATA(3))                              00381400
      M=MSTD(IB,2,2,0,0,TC(NI,IN),DATA(4))                              00381500
      M=MSTD(IB,2,2,0,0,DC(NI,IN),DATA(5))                              00381600
      M=MSTD(IB,2,2,0,0,ZC(NI,IN),DATA(6))                              00381700
      M=MSTD(IB,1,2,ITC(NI,IN),0,0.0,DATA(7))                           00381800
      IF (ITC(NI,IN).EQ.0) ITC(NI,IN)=IBLK                              00381900
      M=MSTD(IB,1,2,NCI(NI,IN),0,0.0,DATA(8))                           00382000
      IF (NCI(NI,IN).EQ.0) NCI(NI,IN)=IBLK                              00382100
      M=MSTD(IB,1,2,NCJ(NI,IN),0,0.0,DATA(9))                           00382200
      IF (NCJ(NI,IN).EQ.0) NCJ(NI,IN)=IBLK                              00382300
 4150 CONTINUE                                                          00382400
 4200 IF (INPO(INO).NE.1) GO TO 4290                                    00382500
      NCOI=NCO(IN)                                                      00382600
      IF (NCOI.EQ.0) GO TO 4290                                         00382700
      NCOO=NCOO+1                                                       00382800
      IF (IPNT.GT.99.AND.INPP(INO).LE.1) GO TO 4290                     00382801
 4210 IF (IN.EQ.1) WRITE (6,400) NCASE,NCOI                             00382900
      IF (IN.EQ.2) WRITE (6,410) NCASE,NCOI                             00383000
      IF (IN.EQ.3) WRITE (6,420) NCASE,NCOI                             00383100
      DO 4220 I=1,NCOI                                                  00383200
      ENCODE(120,430,AAA) NC(I,IN),FC(I,IN),HC(I,IN)                    00383300
      IF (NCI(I,IN).EQ.IBLK.AND.NCJ(I,IN).EQ.IBLK)                      00383400
     *ENCODE(120,440,AAA) NC(I,IN),FC(I,IN),HC(I,IN),TC(I,IN)           00383500
      M=MPTD(2,45,12,3,0,DC(I,IN))                                      00383600
      M=MPTD(2,57,12,3,0,ZC(I,IN))                                      00383700
      M=MPTD(1,69,10,0,ITC(I,IN),0.0)                                   00383800
      M=MPTD(1,79,10,0,NCI(I,IN),0.0)                                   00383900
      M=MPTD(1,89,10,0,NCJ(I,IN),0.0)                                   00384000
      WRITE (6,101) AAA                                                 00384001
 4220 CONTINUE                                                          00384100
 4290 CONTINUE                                                          00384200
C                                                                       00384300
C     KNOWN TEMPERATURE DATA                                            00384400
 5000 IF (NCASE.EQ.1) GO TO 5100                                        00384500
      IF (INPO(26).EQ.0) NKTO=0                                         00384600
      IF (IDLTO.EQ.0) GO TO 5100                                        00384700
      NW=NKTO                                                           00384800
      IF (NW.EQ.0) GO TO 5100                                           00384900
      DO 5040 I=1,NW                                                    00385000
 5005 IF (I.GT.NKTO) GO TO 5100                                         00385100
      M=NKT(I)                                                          00385200
      DO 5010 J=1,IDLTO                                                 00385300
      IF (IDLT(J).EQ.M) GO TO 5020                                      00385400
 5010 CONTINUE                                                          00385500
      GO TO 5040                                                        00385600
 5020 NKTO=NKTO-1                                                       00385700
      IF (NKTO.EQ.0) GO TO 5100                                         00385800
      NI=I                                                              00385900
      IF (NI.GT.NKTO) GO TO 5040                                        00386000
      DO 5030 J=NI,NKTO                                                 00386100
      JS=J+1                                                            00386200
      NKT(J)=NKT(JS)                                                    00386300
      INKT(J)=INKT(JS)                                                  00386400
 5030 TNKT(J)=TNKT(JS)                                                  00386500
      GO TO 5005                                                        00386600
 5040 CONTINUE                                                          00386700
 5100 IF (INRO(26).NE.1) GO TO 5200                                     00386800
      ICD=ICRD(1,11,DATA)                                               00386900
      NW=DATA(1)                                                        00387000
      IF (NW.EQ.0) GO TO 5200                                           00387100
      DO 5150 I=1,NW                                                    00387200
      ICD=ICRD(3,11,DATA)                                               00387300
      IF (ICD.EQ.8) GO TO 5200                                          00387400
      N=DATA(1)                                                         00387500
      IF (N.EQ.0) GO TO 5150                                            00387600
      NI=LONP(N,NKTO,NKT)                                               00387700
      IF (N.GT.0) GO TO 5130                                            00387800
      IF (NI.EQ.0) GO TO 5150                                           00387900
 5110 NKTO=NKTO-1                                                       00388000
      IF (NI.GT.NKTO) GO TO 5150                                        00388100
      DO 5120 J=NI,NKTO                                                 00388200
      JS=J+1                                                            00388300
      NKT(J)=NKT(JS)                                                    00388400
      INKT(J)=INKT(JS)                                                  00388500
 5120 TNKT(J)=TNKT(JS)                                                  00388600
      GO TO 5150                                                        00388700
 5130 IB=2                                                              00388800
      IF (NI.GT.0) GO TO 5140                                           00388900
      NKTO=NKTO+1                                                       00389000
      NI=NKTO                                                           00389100
      IB=1                                                              00389200
 5140 IF (NCASE.EQ.1) IB=1                                              00389300
      NKT(NI)=N                                                         00389400
      M=MSTD(IB,2,2,0,0,TNKT(NI),DATA(2))                               00389500
      M=MSTD(IB,1,2,INKT(NI),0,0.0,DATA(3))                             00389600
 5150 CONTINUE                                                          00389700
 5200 IF (INPO(26).NE.1) GO TO 9000                                     00389800
      IF (IPNT.GT.99.AND.INPP(26).LE.1) GO TO 9000                      00389801
      IF (NKTO.EQ.0) GO TO 9000                                         00389900
 5210 WRITE (6,500) NCASE,NKTO                                          00390000
      DO 5220 I=1,NKTO                                                  00390100
      ENCODE(120,510,AAA) NKT(I)                                        00390200
      M=MPTD(2,9,12,3,0,TNKT(I))                                        00390300
      M=MPTD(1,21,10,0,INKT(I),0.0)                                     00390400
      WRITE (6,101) AAA                                                 00390401
 5220 CONTINUE                                                          00390500
C                                                                       00390600
C     EXIT                                                              00390700
 9000 RETURN                                                            00390800
      END                                                               00390900
*DECK INPS                                                              00390901
C     SUBROUTINE INPS OF PROGRAM XF0031                                 00391000
C     L.W. FESLER     41-383/530  X4263                                 00391100
C                                                                       00391200
C                *****      *****      *****      *****                 00391300
C                                                                       00391400
C     THIS SUBROUTINE READS THE SPECIAL INPUT DATA AND PRINTS THE       00391500
C     SPECIAL INPUT DATA.                                               00391600
C                                                                       00391700
C                *****      *****      *****      *****                 00391800
C                                                                       00391900
      SUBROUTINE INPS                                                   00392000
C                                                                       00392100
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00392200
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00392300
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00392400
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00392500
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00392600
     5              ICLOCK,IDOMT,INPP(33)                               00392601
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00392700
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00392800
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00392900
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00393000
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00393100
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00393200
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00393300
      COMMON /CMN9/ NCRTO(5),NCRT(11,50,5),NCSEO,NCSE(300),NCSSO,       00393400
     1              NCSS(99),NCPT(99),NHLDO,NHLD(300),NHRTO,NHRT(300),  00393500
     2              TENRY,TDOWN,YSCLE(2,5),IPCRT                        00393600
      COMMON /CMNP/ AAA(12)                                             00393601
C                                                                       00393700
      DIMENSION DATA(20),IDUM(50)                                       00393800
C                                                                       00393900
      DATA IBLK,BLK / 77777777777777777777B,77777777777777777777B /     00394000
C                                                                       00394100
  101 FORMAT(12A10)                                                     00394101
  600 FORMAT(1H15X,"PHASE CHANGE DATA"/1H 5X,"NCASE",I4///              00394200
     11H 5X,"NPCMO=",I4//1H 5X,"NPCM",6X,"TPCM1",6X,"QPCM1",6X,         00394300
     2"TPCM2",6X,"QPCM2",6X,"TPCM3",6X,"QPCM3",3X,"MATERIAL")           00394400
  610 FORMAT(6(1H ),I4,2F11.3,47(1H ),7A4,A2,11(1H ))                   00394500
  700 FORMAT(1H15X,"SPECIFIED CRT GRAPHS"/1H 5X,"NCASE",I4)             00394600
  710 FORMAT(1H //1H 5X,"NCRT1=",I4,5X,"TEMPERATURE VERSUS TIME",3X,    00394700
     1"(MULTICASE-MULTISECTION GRAPHS)"//1H 5X,"GRAPH",2X,3X,"CASEA",   00394800
     23X,"SECTA",2X,3X,"CASEB",3X,"SECTB",2X,3X,"CASEC",3X,"SECTC",     00394900
     32X,3X,"CASED",3X,"SECTD",2X,3X,"CASEE",3X,"SECTE")                00395000
  720 FORMAT(1H //1H 5X,"NCRT2=",I4,5X,"TEMPERATURE VERSUS TIME",3X,    00395100
     1"(MULTISECTION GRAPHS)"//1H 5X,"GRAPH",2X,3X,"SECTA",             00395200
     23X,"SECTB",3X,"SECTC",3X,"SECTD",3X,"SECTE",3X,"SECTF",3X,        00395300
     3"SECTG",3X,"SECTH",3X,"SECTI",3X,"SECTJ")                         00395400
  730 FORMAT(1H //1H 5X,"NCRT3=",I4,5X,"TEMPERATURE DIFFERENCE VERSUS", 00395500
     1" TIME   (MULTISECTION GRAPHS)"//1H 5X,"GRAPH",2X,3X,"SCTIA",3X,  00395600
     2"SCTJA",2X,3X,"SCTIB",3X,"SCTJB",2X,3X,"SCTIC",3X,"SCTJC",        00395700
     32X,3X,"SCTID",3X,"SCTJD",2X,3X,"SCTIE",3X,"SCTJE")                00395800
  740 FORMAT(1H //1H 5X,"NCRT4=",I4,5X,"HEATING LOAD VERSUS TIME",      00395900
     13X,"(MULTISECTION GRAPHS)"//1H 5X,"GRAPH",2X,3X,"SECTA",3X,       00396000
     2"SECTB",3X,"SECTC",3X,"SECTD",3X,"SECTE")                         00396100
  750 FORMAT(1H //1H 5X,"NCRT5=",I4,5X,"HEATING RATE VERSUS TIME",      00396200
     13X,"(MULTISECTION GRAPHS)"//1H 5X,"GRAPH",2X,3X,"SECTA",3X,       00396300
     2"SECTB",3X,"SECTC",3X,"SECTD",3X,"SECTE")                         00396400
  760 FORMAT(120(1H ))                                                  00396500
  770 FORMAT(1H //1H 5X,"ENTRY TIME=",F10.3,8X,"TOUCHDOWN TIME=",F10.3) 00396600
C                                                                       00396700
C     PHASE CHANGE DATA                                                 00396800
 6000 IPNT=IABS(INPO(35))                                               00396900
      IF (NCASE.EQ.1) IPNT=1                                            00396901
      IF (NCASE.EQ.1) GO TO 6100                                        00396902
      IF (INPO(27).EQ.0) NPCMO=0                                        00397000
      IF (IDLTO.EQ.0) GO TO 6100                                        00397100
      NW=NPCMO                                                          00397200
      IF (NW.EQ.0) GO TO 6100                                           00397300
      DO 6040 I=1,NW                                                    00397400
 6005 IF (I.GT.NPCMO) GO TO 6100                                        00397500
      M=NPCM(I)                                                         00397600
      DO 6010 J=1,IDLTO                                                 00397700
      IF (IDLT(J).EQ.M) GO TO 6020                                      00397800
 6010 CONTINUE                                                          00397900
      GO TO 6040                                                        00398000
 6020 NPCMO=NPCMO-1                                                     00398100
      IF (NPCMO.EQ.0) GO TO 6100                                        00398200
      NI=I                                                              00398300
      IF (NI.GT.NPCMO) GO TO 6040                                       00398400
      DO 6030 J=NI,NPCMO                                                00398500
      JS=J+1                                                            00398600
      NPCM(J)=NPCM(JS)                                                  00398700
      DO 6025 K=1,3                                                     00398800
      TPCM(K,J)=TPCM(K,JS)                                              00398900
 6025 QPCM(K,J)=QPCM(K,JS)                                              00399000
      DO 6030 K=1,8                                                     00399100
      BCDP(K,J)=BCDP(K,JS)                                              00399200
 6030 CONTINUE                                                          00399300
      GO TO 6005                                                        00399400
 6040 CONTINUE                                                          00399500
 6100 IF (INRO(27).NE.1) GO TO 6200                                     00399600
      ICD=ICRD(1,12,DATA)                                               00399700
      NW=DATA(1)                                                        00399800
      IF (NW.EQ.0) GO TO 6200                                           00399900
      DO 6160 I=1,NW                                                    00400000
      ICD=ICRD(7,12,DATA)                                               00400100
      IF (ICD.EQ.8) GO TO 6200                                          00400200
      N=DATA(1)                                                         00400300
      IF (N.EQ.0) GO TO 6160                                            00400400
      NI=LONP(N,NPCMO,NPCM)                                             00400500
      IF (N.GT.0) GO TO 6130                                            00400600
 6110 NPCMO=NPCMO-1                                                     00400700
      IF (NI.GT.NPCMO) GO TO 6160                                       00400800
      DO 6120 J=NI,NPCMO                                                00400900
      JS=J+1                                                            00401000
      NPCM(J)=NPCM(JS)                                                  00401100
      DO 6115 K=1,3                                                     00401200
      TPCM(K,J)=TPCM(K,JS)                                              00401300
 6115 QPCM(K,J)=QPCM(K,JS)                                              00401400
      DO 6120 K=1,8                                                     00401500
      BCDP(K,J)=BCDP(K,JS)                                              00401600
 6120 CONTINUE                                                          00401700
      GO TO 6160                                                        00401800
 6130 IB=2                                                              00401900
      IF (NI.GT.0) GO TO 6140                                           00402000
      NPCMO=NPCMO+1                                                     00402100
      NI=NPCMO                                                          00402200
      IB=1                                                              00402300
 6140 IF (NCASE.EQ.1) IB=1                                              00402400
      NPCM(NI)=N                                                        00402500
      M=MSTD(IB,2,2,0,0,TPCM(1,NI),DATA(2))                             00402600
      M=MSTD(IB,2,2,0,0,QPCM(1,NI),DATA(3))                             00402700
      M=MSTD(IB,2,2,0,0,TPCM(2,NI),DATA(4))                             00402800
      M=MSTD(IB,2,2,0,0,QPCM(2,NI),DATA(5))                             00402900
      M=MSTD(IB,2,2,0,0,TPCM(3,NI),DATA(6))                             00403000
      M=MSTD(IB,2,2,0,0,QPCM(3,NI),DATA(7))                             00403100
      DO 6150 J=1,8                                                     00403200
      M=MSTD(IB,2,2,0,0,BCDP(J,NI),DATA(J+7))                           00403300
 6150 CONTINUE                                                          00403400
 6160 CONTINUE                                                          00403500
 6200 IF (INPO(27).NE.1) GO TO 7000                                     00403600
      IF (IPNT.GT.99.AND.INPP(27).LE.1) GO TO 7000                      00403601
      IF (NPCMO.EQ.0) GO TO 7000                                        00403700
 6210 WRITE (6,600) NCASE,NPCMO                                         00403800
      DO 6220 I=1,NPCMO                                                 00403900
      ENCODE(120,610,AAA) NPCM(I),TPCM(1,I),QPCM(1,I),(BCDP(J,I),J=1,8) 00404000
      M=MPTD(2,31,11,3,0,TPCM(2,I))                                     00404100
      M=MPTD(2,42,11,3,0,QPCM(2,I))                                     00404200
      M=MPTD(2,53,11,3,0,TPCM(3,I))                                     00404300
      M=MPTD(2,64,11,3,0,QPCM(3,I))                                     00404400
      WRITE (6,101) AAA                                                 00404401
 6220 CONTINUE                                                          00404500
C                                                                       00404600
C     SPECIFIED CRT DATA                                                00404700
 7000 IFLAG=0                                                           00404800
      NCRTOO=0                                                          00404900
      DO 7290 IN=1,5                                                    00405000
      INO=28+IN                                                         00405100
      IDX=11                                                            00405200
      IF (IN.GT.3) IDX=6                                                00405300
      IF (NCASE.EQ.1) GO TO 7100                                        00405400
      IF (INPO(INO).EQ.0) NCRTO(IN)=0                                   00405500
      IF (IDLTO.EQ.0) GO TO 7100                                        00405600
      IF (IN.EQ.1) GO TO 7100                                           00405700
      NW=NCRTO(IN)                                                      00405800
      IF (NW.EQ.0) GO TO 7100                                           00405900
      DO 7080 I=1,NW                                                    00406000
 7005 IF (I.GT.NCRTO(IN)) GO TO 7100                                    00406100
      DO 7040 J=1,IDLTO                                                 00406200
      M=IDLT(J)                                                         00406300
      IF (IN.NE.3) GO TO 7020                                           00406400
      DO 7010 K=2,6                                                     00406500
      IF (NCRT(K,I,IN).NE.M) GO TO 7010                                 00406600
      NCRT(K,I,IN)=IBLK                                                 00406700
      NCRT(K+5,I,IN)=IBLK                                               00406800
 7010 CONTINUE                                                          00406900
      GO TO 7040                                                        00407000
 7020 DO 7030 K=2,IDX                                                   00407100
      IF (NCRT(K,I,IN).EQ.M) NCRT(K,I,IN)=IBLK                          00407200
 7030 CONTINUE                                                          00407300
 7040 CONTINUE                                                          00407400
      DO 7050 J=2,IDX                                                   00407500
      IF (NCRT(J,I,IN).NE.IBLK) GO TO 7080                              00407600
 7050 CONTINUE                                                          00407700
 7060 NCRTO(IN)=NCRTO(IN)-1                                             00407800
      NCRTI=NCRTO(IN)                                                   00407900
      IF (NCRTI.EQ.0) GO TO 7100                                        00408000
      NI=I                                                              00408100
      IF (NI.GT.NCRTI) GO TO 7100                                       00408200
      DO 7070 J=NI,NCRTI                                                00408300
      JS=J+1                                                            00408400
      DO 7070 K=1,IDX                                                   00408500
      NCRT(K,J,IN)=NCRT(K,JS,IN)                                        00408600
 7070 CONTINUE                                                          00408700
      GO TO 7005                                                        00408800
 7080 CONTINUE                                                          00408900
 7100 IF (INRO(INO).NE.1) GO TO 7200                                    00409000
      INPOO=INPO(28)                                                    00409100
      IF (INPOO.LT.-5) INPOO=0                                          00409200
      INPAO=IABS(INPOO)                                                 00409300
      IWR=1                                                             00409400
      IF (INPOO.LT.0) IWR=3                                             00409500
      IF (INPAO.EQ.3.OR.INPAO.EQ.5) IWR=5                               00409600
      ICD=ICRD(IWR,13,DATA)                                             00409700
      NW=DATA(1)                                                        00409800
      IF (INPAO.LT.2) GO TO 7103                                        00409900
      IB=2                                                              00410000
      IF (INPOO.LT.0)  M=MSTD(IB,2,2,0,0,TENRY,DATA(2))                 00410100
      IF (INPOO.LT.0)  M=MSTD(IB,2,2,0,0,TDOWN,DATA(3))                 00410200
      IF (NCASE.EQ.1) IB=1                                              00410300
      IF (INPAO.EQ.3.OR.INPAO.EQ.5)                                     00410400
     *M=MSTD(IB,2,2,0,0,YSCLE(1,IN),DATA(4))                            00410500
      IF (INPAO.EQ.3.OR.INPAO.EQ.5)                                     00410600
     *M=MSTD(IB,2,2,0,0,YSCLE(2,IN),DATA(5))                            00410700
 7103 IF (NW.EQ.0) GO TO 7200                                           00410800
      DO 7160 I=1,NW                                                    00410900
      ICD=ICRD(IDX,13,DATA)                                             00411000
      IF (ICD.EQ.8) GO TO 7200                                          00411100
      N=IBLK                                                            00411200
      IF (DATA(1).EQ.BLK) GO TO 7135                                    00411300
      N=DATA(1)                                                         00411400
      NCRTI=NCRTO(IN)                                                   00411500
      DO 7105 J=1,NCRTI                                                 00411600
 7105 IDUM(J)=NCRT(1,J,IN)                                              00411700
      NI=LONP(N,NCRTI,IDUM)                                             00411800
      IF (N.GE.0) GO TO 7130                                            00411900
 7110 NCRTO(IN)=NCRTO(IN)-1                                             00412000
      NCRTI=NCRTO(IN)                                                   00412100
      IF (NI.GT.NCRTI) GO TO 7160                                       00412200
      DO 7120 J=NI,NCRTI                                                00412300
      JS=J+1                                                            00412400
      DO 7120 K=1,IDX                                                   00412500
      NCRT(K,J,IN)=NCRT(K,JS,IN)                                        00412600
 7120 CONTINUE                                                          00412700
      GO TO 7160                                                        00412800
 7130 IB=2                                                              00412900
      IF (NI.GT.0) GO TO 7140                                           00413000
 7135 NCRTO(IN)=NCRTO(IN)+1                                             00413100
      NI=NCRTO(IN)                                                      00413200
      IB=1                                                              00413300
 7140 IF (NCASE.EQ.1) IB=1                                              00413400
      NCRT(1,NI,IN)=N                                                   00413500
      DO 7150 J=2,IDX                                                   00413600
      M=MSTD(IB,1,2,NCRT(J,NI,IN),0,0.0,DATA(J))                        00413700
 7150 CONTINUE                                                          00413800
 7160 CONTINUE                                                          00413900
 7200 IF (INPO(INO).NE.1) GO TO 7290                                    00414000
      NCRTI=NCRTO(IN)                                                   00414100
      IF (NCRTI.EQ.0) GO TO 7290                                        00414200
      NCRTOO=NCRTOO+1                                                   00414300
      IF (IPNT.GT.99.AND.INPP(INO).LE.1) GO TO 7290                     00414301
 7210 IF (IFLAG.NE.0) GO TO 7220                                        00414400
      WRITE (6,700) NCASE                                               00414500
      IFLAG=1                                                           00414600
 7220 IF (IN.EQ.1) WRITE (6,710) NCRTI                                  00414700
      IF (IN.EQ.2) WRITE (6,720) NCRTI                                  00414800
      IF (IN.EQ.3) WRITE (6,730) NCRTI                                  00414900
      IF (IN.EQ.4) WRITE (6,740) NCRTI                                  00415000
      IF (IN.EQ.5) WRITE (6,750) NCRTI                                  00415100
      DO 7235 I=1,NCRTI                                                 00415200
      ENCODE(120,760,AAA)                                               00415300
      M=MPTD(1,5,5,0,NCRT(1,I,IN),0.0)                                  00415400
      IS=4                                                              00415500
      ISO=8                                                             00415600
      DO 7230 J=2,IDX                                                   00415700
      IS=IS+ISO                                                         00415800
      ISO=8                                                             00415900
      IF (IN.EQ.2.OR.IN.GT.3) GO TO 7225                                00416000
      IF (J.EQ.2) GO TO 7225                                            00416100
      IF (MOD(J,2).EQ.0) ISO=10                                         00416200
 7225 M=MPTD(1,IS,ISO,0,NCRT(J,I,IN),0.0)                               00416300
 7230 CONTINUE                                                          00416400
      WRITE (6,101) AAA                                                 00416401
 7235 CONTINUE                                                          00416402
 7290 CONTINUE                                                          00416500
      IF (INPO(28).GT.-2) GO TO 8000                                    00416600
      IF (INPO(28).LT.-5) GO TO 8000                                    00416700
      IF (IFLAG.EQ.0) GO TO 8000                                        00416701
      WRITE (6,770) TENRY,TDOWN                                         00416800
C                                                                       00416900
C     SPECIAL CRT STORAGE ARRAYS                                        00417000
 8000 IF (NCRTOO.EQ.0) GO TO 9000                                       00417100
      NCSEO=0                                                           00417200
      NCSE(1)=0                                                         00417300
      NCRTI=NCRTO(1)                                                    00417400
      IF (NCRTI.EQ.0) GO TO 8050                                        00417500
      DO 8010 I=1,NCRTI                                                 00417600
      DO 8010 J=2,11,2                                                  00417700
      IF (NCRT(J+1,I,1).LE.0) GO TO 8010                                00417800
      IF (NCRT(J,I,1).NE.NCASE) GO TO 8010                              00417900
      NBR=NCRT(J+1,I,1)                                                 00418000
      NI=LONP(NBR,NCSEO,NCSE)                                           00418100
      IF (NI.GT.0) GO TO 8010                                           00418200
      NCSEO=NCSEO+1                                                     00418300
      NCSE(NCSEO)=NBR                                                   00418400
 8010 CONTINUE                                                          00418500
 8050 NHLDO=0                                                           00418600
      NHRTO=0                                                           00418700
      DO 8090 IN=1,2                                                    00418800
      INO=3+IN                                                          00418900
      NCRTI=NCRTO(INO)                                                  00419000
      IF (NCRTI.EQ.0) GO TO 8090                                        00419100
      DO 8080 I=1,NCRTI                                                 00419200
      NBR=0                                                             00419300
      DO 8070 J=2,6                                                     00419400
      IF (NCRT(J,I,INO).LE.0) GO TO 8070                                00419500
      NBR=NBR+1                                                         00419600
      IF (IN.EQ.2) GO TO 8060                                           00419700
      NHLDO=NHLDO+1                                                     00419800
      NHLD(NHLDO)=NCRT(J,I,INO)                                         00419900
      GO TO 8070                                                        00420000
 8060 NHRTO=NHRTO+1                                                     00420100
      NHRT(NHRTO)=NCRT(J,I,INO)                                         00420200
 8070 CONTINUE                                                          00420300
      IF (IN.EQ.1) NCRT(7,I,4)=NHLDO-NBR+1                              00420400
      IF (IN.EQ.2) NCRT(7,I,5)=NHRTO-NBR+1                              00420500
      NCRT(8,I,INO)=NBR                                                 00420600
 8080 CONTINUE                                                          00420700
 8090 CONTINUE                                                          00420800
C                                                                       00420900
C     EXIT                                                              00421000
 9000 RETURN                                                            00421100
      END                                                               00421200
*DECK TBLS                                                              00421201
C     SUBROUTINE TBLS OF PROGRAM XF0031                                 00421300
C     L.W. FESLER     41-383/530  X4263                                 00421400
C                                                                       00421500
C                *****      *****      *****      *****                 00421600
C                                                                       00421700
C     THIS SUBROUTINE READS THE TABLE DATA AND PRINTS THE               00421800
C     TABLE DATA.                                                       00421900
C                                                                       00422000
C                *****      *****      *****      *****                 00422100
C                                                                       00422200
      SUBROUTINE TBLS                                                   00422300
C                                                                       00422400
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00422500
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00422600
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00422700
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00422800
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00422900
     5              ICLOCK,IDOMT,INPP(33)                               00422901
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00423000
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00423100
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00423200
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00423300
      COMMON /CMN3/ TBSTG(4000),TBID(14,99)                             00423400
      DIMENSION IBSTG(4000)                                             00423500
      EQUIVALENCE (TBSTG(1),IBSTG(1))                                   00423600
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00423700
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00423800
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00423900
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00424000
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00424100
     2              DGP2(75),PGSF(75),BQGP(75),                         00424200
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00424300
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00424400
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00424500
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00424600
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00424700
     3              FP(75,3,2),BQA(75,3,2),                             00424800
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00424900
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00425000
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00425100
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00425200
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00425300
C                                                                       00425400
      DIMENSION DATA(20),IDTA(500),FMT(5),TLE(14),TLP(14),              00425500
     1          IDDD(14),AR1(880),AR2(880),ARR(1800),ARY(1786)          00425600
      EQUIVALENCE (IDTA(1),COET(1,1)),(ARR(1),BCOET(1,1)),              00425700
     1            (FIW,IIW),(IBDY,BDY),                                 00425800
     2            (ARR(15),ARY(1)),(ARR(1),AR1(1),IDDD(1)),             00425900
     3            (ARR(881),AR2(1))                                     00426000
      COMMON /CDCD/ IRAND(7000)                                         00426001
C                                                                       00426100
      DATA FMT / 4H(1H ,3H3X,,1H ,4HF13.,2H5) /                         00426400
      DATA INBR,INRB / 33333333333333333333B,33335555555555555555B /    00426500
      DATA TLE / 4HTABL,4HE FR,4HOM E,4HBCDI,4HC CA,3HRDS,              00426600
     1           "    ","DATE",6*1H  /                                  00426700
      DATA TLP / "TABL","E FR","OM D","ATA ","SET ",2*1H ,              00426800
     1           "  **","****","  DA","TE 7",1H ,"  **","****" /        00426900
      DATA DOA,DAE,DOE / "OA","AE","OE" /                               00427000
C                                                                       00427100
  100 FORMAT(12F6.0)                                                    00427101
  300 FORMAT(1H15X,"TABLE NUMBER",I7,5X,14A4/1H 5X,"NCASE",I4///        00427200
     11H 5X,"NE=",I4/1H 5X)                                             00427300
  310 FORMAT(1H 16X,7F13.4)                                             00427400
  400 FORMAT(1H1//1H 5X,"TABLE NUMBER",I7," IS NOT REQUIRED")           00427500
  410 FORMAT(1H1//1H 5X,"TABLE NUMBER",I7," IS MISSING"/                00427600
     11H 5X,"INDEX",I7," DOES NOT CONTAIN PERMANENT DATA")              00427700
  420 FORMAT(1H1//1H 5X,"DATA FILE INDEX",I7," DOES NOT CONTAIN ",      00427800
     1       "DATA FOR BODY POINT",I7)                                  00427900
  500 FORMAT(1H1//1H 5X,"END OF JOB - MISSING TABLES"/                  00428100
     1(1H 5X,"TABLE NUMBER",I7))                                        00428200
C                                                                       00428300
C     TABLE NUMBERS                                                     00428400
 1000 NTB=0                                                             00428500
      IPNT=IABS(INPO(35))                                               00428501
      DO 1010 I=1,2                                                     00428600
      IF (I.EQ.1) TST=DELT                                              00428700
      IF (I.EQ.2) TST=DELTP                                             00428800
      IF (TST.GE.0.0) GO TO 1010                                        00428900
      NTB=NTB+1                                                         00429000
      IDTA(NTB)=-TST                                                    00429100
 1010 CONTINUE                                                          00429200
      DO 1020 I=1,NMTLO                                                 00429300
      IMTL=NMTL(I)                                                      00429400
      DO 1020 J=1,7                                                     00429500
      IF (J.EQ.1) TST=RHO(I)                                            00429600
      IF (J.EQ.2) TST=CP(I)                                             00429700
      IF (J.EQ.3) TST=TKX(I)                                            00429800
      IF (J.EQ.4) TST=TKY(I)                                            00429900
      IF (J.EQ.5) TST=TKZ(I)                                            00430000
      IF (J.EQ.6) TST=PMSF(I)                                           00430100
      IF (J.LT.7) GO TO 1015                                            00430200
      IF (IMTL.LT.1000) GO TO 1020                                      00430300
      TST=BCDM(8,I)                                                     00430400
 1015 IF (TST.GE.0.0) GO TO 1020                                        00430500
      NTB=NTB+1                                                         00430600
      IDTA(NTB)=-TST                                                    00430700
 1020 CONTINUE                                                          00430800
      IF (NGAPO.EQ.0) GO TO 1100                                        00430900
      DO 1030 I=1,NGAPO                                                 00431000
      DO 1030 J=1,5                                                     00431100
      IF (J.EQ.1) TST=TKG(I)                                            00431200
      IF (J.EQ.2) TST=TKC(I)                                            00431300
      IF (J.EQ.3) TST=EGPI(I)                                           00431400
      IF (J.EQ.4) TST=EGPJ(I)                                           00431500
      IF (J.EQ.5) TST=PGSF(I)                                           00431600
      IF (TST.GE.0.0) GO TO 1030                                        00431700
      NTB=NTB+1                                                         00431800
      IDTA(NTB)=-TST                                                    00431900
 1030 CONTINUE                                                          00432000
 1100 DO 1120 I=1,2                                                     00432100
      DO 1120 J=1,3                                                     00432200
      NAI=NAO(J,I)                                                      00432300
      IF (NAI.EQ.0) GO TO 1120                                          00432400
      DO 1110 K=1,NAI                                                   00432500
      DO 1110 L=1,7                                                     00432600
      IF (L.EQ.1) TST=FA(K,J,I)                                         00432700
      IF (L.EQ.2) TST=QA(K,J,I)                                         00432800
      IF (L.EQ.3) TST=AA(K,J,I)                                         00432900
      IF (L.EQ.4) TST=HR(K,J,I)                                         00433000
      IF (L.EQ.5) TST=FR(K,J,I)                                         00433100
      IF (L.EQ.6) TST=PR(K,J,I)                                         00433200
      IF (L.EQ.7) TST=FP(K,J,I)                                         00433300
      IF (TST.GE.0.0) GO TO 1110                                        00433400
      NTB=NTB+1                                                         00433500
      IDTA(NTB)=-TST                                                    00433600
 1110 CONTINUE                                                          00433700
 1120 CONTINUE                                                          00433800
      DO 1140 I=1,3                                                     00433900
      NRSI=NRSO(I)                                                      00434000
      IF (NRSI.EQ.0) GO TO 1140                                         00434100
      DO 1130 J=1,NRSI                                                  00434200
      DO 1130 K=1,3                                                     00434300
      IF (K.EQ.1) TST=FRS(J,I)                                          00434400
      IF (K.EQ.2) TST=ERS(J,I)                                          00434500
      IF (K.EQ.3) TST=TRS(J,I)                                          00434600
      IF (TST.GE.0.0) GO TO 1130                                        00434700
      IF (K.EQ.3.AND.TST.GE.-460.0) GO TO 1130                          00434800
      NTB=NTB+1                                                         00434900
      IDTA(NTB)=-TST                                                    00435000
 1130 CONTINUE                                                          00435100
 1140 CONTINUE                                                          00435200
      DO 1160 I=1,3                                                     00435300
      NCOI=NCO(I)                                                       00435400
      IF (NCOI.EQ.0) GO TO 1160                                         00435500
      DO 1150 J=1,NCOI                                                  00435600
      DO 1150 K=1,3                                                     00435700
      IF (K.EQ.1) TST=FC(J,I)                                           00435800
      IF (K.EQ.2) TST=HC(J,I)                                           00435900
      IF (K.EQ.3) TST=TC(J,I)                                           00436000
      IF (TST.GE.0.0) GO TO 1150                                        00436100
      IF (K.EQ.3.AND.TST.GE.-460.0) GO TO 1150                          00436200
      NTB=NTB+1                                                         00436300
      IDTA(NTB)=-TST                                                    00436400
 1150 CONTINUE                                                          00436500
 1160 CONTINUE                                                          00436600
      IF (NKTO.EQ.0) GO TO 1200                                         00436700
      DO 1170 I=1,NKTO                                                  00436800
      TST=TNKT(I)                                                       00436900
      IF (TST.GE.-460.0) GO TO 1170                                     00437000
      NTB=NTB+1                                                         00437100
      IDTA(NTB)=-TST                                                    00437200
 1170 CONTINUE                                                          00437300
 1200 IF (NTB.EQ.0) GO TO 2005                                          00437400
      NTBO=NTB                                                          00437500
      DO 1240 I=1,NTBO                                                  00437600
      IF (IDTA(I).GT.0) GO TO 1240                                      00437700
      NTB=NTB-1                                                         00437800
      DO 1235 J=I,NTB                                                   00437900
 1235 IDTA(J)=IDTA(J+1)                                                 00438000
 1240 CONTINUE                                                          00438100
      DO 1230 I=1,NTBO                                                  00438200
      IF (I.GT.NTB) GO TO 2000                                          00438300
      IDTAI=IDTA(I)                                                     00438400
      IF (IDTAI.EQ.0) GO TO 2000                                        00438500
      IS=I+1                                                            00438600
      DO 1230 J=IS,NTBO                                                 00438700
 1210 IF (IDTA(J).NE.IDTAI) GO TO 1230                                  00438800
      IF (IDTA(J).EQ.0) GO TO 1230                                      00438900
      JS=J                                                              00439000
      NTB=NTB-1                                                         00439100
      DO 1220 K=JS,NTB                                                  00439200
 1220 IDTA(K)=IDTA(K+1)                                                 00439300
      IDTA(NTB+1)=0                                                     00439400
      GO TO 1210                                                        00439500
 1230 CONTINUE                                                          00439600
C                                                                       00439700
C     DELETE UNUSED TABLES                                              00439800
 2000 IF (NCASE.NE.1) GO TO 2010                                        00439900
 2005 IBSTG(1)=0                                                        00440000
      IBSTG(2)=201                                                      00440100
      GO TO 4000                                                        00440200
 2010 NTBO=IBSTG(1)                                                     00440300
      IF (NTBO.EQ.0) GO TO 4000                                         00440400
      DO 2090 I=1,NTBO                                                  00440500
 2020 NOTB=ABS(TBSTG(I+2))                                              00440600
      IF (NOTB.EQ.0) GO TO 2090                                         00440700
      DO 2030 J=1,NTB                                                   00440800
      JS=J                                                              00440900
      IF (IDTA(J).EQ.NOTB) GO TO 2070                                   00441000
 2030 CONTINUE                                                          00441100
 2040 LD=IBSTG(I+101)                                                   00441200
      ND=IBSTG(LD+2)*(IBSTG(LD+3)+1)+14                                 00441300
      NF=LD+ND                                                          00441400
      NL=IBSTG(2)-1                                                     00441500
      IBSTG(1)=IBSTG(1)-1                                               00441600
      IBSTG(2)=IBSTG(2)-ND                                              00441700
      NTBL=NTBO-1                                                       00441800
      IF (I.GT.NTBL) GO TO 3000                                         00441900
      DO 2050 J=I,NTBL                                                  00442000
      TBSTG(J+2)=TBSTG(J+3)                                             00442100
      IBSTG(J+101)=IBSTG(J+102)-ND                                      00442200
      DO 2050 K=1,14                                                    00442300
      TBID(K,J)=TBID(K,J+1)                                             00442400
 2050 CONTINUE                                                          00442500
      TBSTG(NTBL+3)=0.0                                                 00442600
      DO 2060 K=NF,NL                                                   00442700
      K1=K-ND                                                           00442800
 2060 TBSTG(K1)=TBSTG(K)                                                00442900
      GO TO 2020                                                        00443000
 2070 NTB=NTB-1                                                         00443100
      IF (NTB.LE.0) GO TO 2090                                          00443200
      DO 2080 J=JS,NTB                                                  00443300
 2080 IDTA(J)=IDTA(J+1)                                                 00443400
      IDTA(NTB+1)=0                                                     00443500
 2090 CONTINUE                                                          00443600
C                                                                       00443700
C     PRINT EXISTING TABLES                                             00443800
 3000 NTBO=IBSTG(1)                                                     00443900
      IF (NTBO.EQ.0) GO TO 4000                                         00444000
      IF (IPNT.GT.99) GO TO 4000                                        00444001
      DO 3010 I=1,NTBO                                                  00444100
      NOTB=TBSTG(I+2)                                                   00444200
      LD=IBSTG(I+101)                                                   00444300
      NE=IBSTG(LD+2)                                                    00444400
      NW=IBSTG(LD+3)                                                    00444500
      NLD=LD+NW-1                                                       00444600
      WRITE (6,300) NOTB,(TBID(J,I),J=1,14),NCASE,NE                    00444700
      IF (NW.GT.1) WRITE (6,310) (TBSTG(J+7),J=LD,NLD)                  00444800
      IIW=INBR+NW+1                                                     00444900
      FMT(3)=FIW                                                        00445000
      NLD=LD+NE*(NW+1)-1                                                00445100
      WRITE (6,FMT) (TBSTG(J+14),J=LD,NLD)                              00445200
 3010 CONTINUE                                                          00445300
C                                                                       00445400
C     READ TABLES                                                       00445500
 4000 IF (NTB.EQ.0) GO TO 5000                                          00445600
      NTBO=NTB                                                          00445700
      IBNRD=0                                                           00445800
      DO 4290 I=1,NTBO                                                  00445900
 4005 NTBS=IBSTG(1)+1                                                   00446000
      LD=IBSTG(2)                                                       00446100
      IF (IBNRD.NE.0) GO TO 4110                                        00446200
      ICD=ICRD(3,14,DATA)                                               00446300
      DOAT=DATA(20)                                                     00446400
      NOTB=DATA(1)                                                      00446500
      M=DATA(2)                                                         00446600
      NW=DATA(3)                                                        00446700
      NWT=NW                                                            00446800
      OFST=DATA(19)                                                     00446900
      IF (NW.LT.-996) GO TO 4100                                        00447000
      IF (NW.LT.-993) GO TO 4101                                        00447100
      IF (NW.EQ.-991) GO TO 4070                                        00447200
      IF (NW.EQ.0) NW=1                                                 00447300
      IF (NW.LT.0) NW=-NW                                               00447400
      NW1=NW+1                                                          00447500
      INTP=DATA(2)                                                      00447600
      DO 4010 J=1,14                                                    00447700
 4010 TBID(J,NTBS)=DATA(J+3)                                            00447800
      ICD=ICRD(8,15,DATA)                                               00447900
      NE=DATA(1)                                                        00448000
      NEI=NE                                                            00448100
      DO 4020 J=1,NW                                                    00448200
      J1=LD+6+J                                                         00448300
 4020 TBSTG(J1)=DATA(J+1)                                               00448400
      IF (NEI.EQ.0) GO TO 4050                                          00448500
      DO 4040 J=1,NEI                                                   00448600
      ICD=ICRD(8,15,DATA)                                               00448700
      IF (ICD.EQ.8) GO TO 4050                                          00448800
      NE=J                                                              00448900
      NLD=LD+13+(J-1)*NW1                                               00449000
      DO 4030 K=1,NW1                                                   00449100
 4030 TBSTG(NLD+K)=DATA(K)                                              00449200
 4040 CONTINUE                                                          00449300
 4050 NOTBS=IABS(NOTB)                                                  00449400
      DO 4060 J=1,NTB                                                   00449500
      JS=J                                                              00449600
      IF (NOTBS.EQ.IDTA(J)) GO TO 4200                                  00449700
 4060 CONTINUE                                                          00449800
      WRITE (6,400) NOTBS                                               00449900
      GO TO 4290                                                        00450000
 4070 MM=IPDA(M,NE,NW)                                                  00450100
      IF (MM.EQ.0) GO TO 4080                                           00450200
      WRITE (6,410) NOTB,M                                              00450300
      GO TO 4290                                                        00450400
 4080 INTP=0                                                            00450500
      NW1=NW+1                                                          00450600
      GO TO 4050                                                        00450700
 4100 KY=1                                                              00450800
      NWDS=0                                                            00450900
      NT=DATA(4)                                                        00450901
      DO 4199 J=1,NT                                                    00450902
      NE=DATA(J+9)                                                      00450903
      NB=DATA(J+4)                                                      00450904
 4199 NWDS=NWDS+NB+(NB+1)*NE                                            00450905
      READ (5,100) (ARY(J),J=1,NWDS)                                    00450906
      TLE(9)=DATA(17)                                                   00451000
      TLE(10)=DATA(18)                                                  00451100
      GO TO 4107                                                        00451200
 4101 I21=M                                                             00451300
      IM=M                                                              00451400
      CALL READMS(12,AR1,880,I21)                                       00451500
      IF (IDDD(2).GT.99999) IDDD(2)=AR1(2)                              00451600
      IF (IDDD(2).NE.NOTB) GO TO 4104                                   00451700
      IF (DOAT.NE.DAE) GO TO 4102                                       00451800
      M1=M+2000                                                         00451900
      NIX=DATA(16)                                                      00452000
      IF (NIX.GT.0) M1=M+NIX                                            00452100
      I21=M1                                                            00452200
      IM=M1                                                             00452300
      CALL READMS(12,AR2,880,I21)                                       00452400
      IBDYO=IDDD(882)                                                   00452500
      IF (IBDYO.GT.99999) IBDYO=AR2(2)                                  00452600
      IF (IBDYO.NE.NOTB) GO TO 4104                                     00452700
      CALL COPT(OFST,ARR)                                               00452800
 4102 DO 4103 J=4,14                                                    00452900
 4103 DATA(J)=IDDD(J-1)                                                 00453000
      IF (DOAT.EQ.DOE.AND.OFST.GT.0.0) M=99                             00453100
      IF (DOAT.EQ.DAE) OFST=0.0                                         00453200
      IDT=IDDD(14)                                                      00453300
      IW=IDT-10000*(IDT/10000)                                          00453400
      IW1=IW/1000                                                       00453500
      IW2=(IW-1000*IW1)/100                                             00453600
      IW3=(IW-1000*IW1-100*IW2)/10                                      00453700
      IW4=IW-1000*IW1-100*IW2-10*IW3                                    00453800
      IIW=INBR+((64*IW1+IW2)*64+IW3)*64+IW4                             00453900
      IIW=SHIFT(IIW,36)                                                 00453901
      TLP(12)=FIW                                                       00454000
      TLP(6)=TLP(7)                                                     00454100
      IW=ARR(880)                                                       00454200
      IF (DOAT.EQ.DAE) IW=ARR(1760)                                     00454300
      IF (IW.LT.10.OR.IW.GT.35) GO TO 4107                              00454400
      IW1=IW/10                                                         00454500
      IW2=IW-10*IW1                                                     00454600
      IIW=INRB+(64*IW1+IW2)                                             00454700
      IIW=SHIFT(IIW,48)                                                 00454701
      TLP(6)=FIW                                                        00454800
      GO TO 4107                                                        00454900
 4104 WRITE (6,420) IM,NOTB                                             00455000
      GO TO 4290                                                        00455100
 4107 IBNRD=DATA(4)+1.0                                                 00455400
      ITO=IBNRD                                                         00455500
      NOTB=10*NOTB                                                      00455600
      IF (DOAT.EQ.DOA) NOTB=NOTB+5                                      00455700
      IS=0                                                              00455800
      NDS=0                                                             00455900
 4110 NOTB=NOTB+1                                                       00456000
      INTP=1                                                            00456100
      IBNRD=IBNRD-1                                                     00456200
      IF (DOAT.EQ.DOA.AND.IBNRD.EQ.1) NOTB=NOTB-10                      00456300
      IF (IBNRD.EQ.0) GO TO 4005                                        00456400
      IT=ITO-IBNRD                                                      00456500
      NW=DATA(IT+4)                                                     00456600
      IF (NW.EQ.0) NW=1                                                 00456700
      NW1=NW+1                                                          00456800
      NE=DATA(IT+9)                                                     00456900
      IS=IS+NDS                                                         00457000
      ND=NE*NW1                                                         00457100
      NDS=ND+NW                                                         00457200
      DO 4120 J=1,NTB                                                   00457300
      JS=J                                                              00457400
      IF (NOTB.EQ.IDTA(J)) GO TO 4130                                   00457500
 4120 CONTINUE                                                          00457600
      GO TO 4110                                                        00457700
 4130 DO 4140 J=1,14                                                    00457800
      IF (NWT.LT.-996) TBID(J,NTBS)=TLE(J)                              00457900
      IF (NWT.GT.-996) TBID(J,NTBS)=TLP(J)                              00458000
 4140 CONTINUE                                                          00458100
      DO 4150 J=1,NW                                                    00458200
      J1=LD+6+J                                                         00458300
      J2=IS+J                                                           00458400
 4150 TBSTG(J1)=ARY(J2)                                                 00458500
      DO 4160 J=1,ND                                                    00458600
      J1=LD+13+J                                                        00458700
      J2=IS+NW+J                                                        00458800
 4160 TBSTG(J1)=ARY(J2)                                                 00458900
 4200 NTB=NTB-1                                                         00459000
      DO 4210 J=JS,NTB                                                  00459100
 4210 IDTA(J)=IDTA(J+1)                                                 00459200
      IBSTG(1)=IBSTG(1)+1                                               00459300
      TBSTG(NTBS+2)=NOTB                                                00459400
      IBSTG(NTBS+101)=IBSTG(2)                                          00459500
      ND=NE*NW1+14                                                      00459600
      IBSTG(2)=IBSTG(2)+ND                                              00459700
      IBSTG(LD)=NOTB                                                    00459800
      IBSTG(LD+1)=INTP                                                  00459900
      IBSTG(LD+2)=NE                                                    00460000
      IBSTG(LD+3)=NW                                                    00460100
      IBSTG(LD+4)=4*NW1                                                 00460200
      IBSTG(LD+5)=4*NW1*(NE-1)                                          00460300
      IBSTG(LD+6)=4*NW1                                                 00460400
      IF (OFST.EQ.0.0) GO TO 4230                                       00460500
      DO 4220 J=1,NE                                                    00460600
      K=LD+14+(J-1)*(NW+1)                                              00460700
 4220 TBSTG(K)=TBSTG(K)+OFST                                            00460800
      IF (OFST.LE.0.0) GO TO 4230                                       00460900
      IF (M.NE.99) GO TO 4230                                           00461000
      NW2=2*NW1                                                         00461100
      IBSTG(2)=IBSTG(2)+NW2                                             00461200
      ND=NE*NW1                                                         00461300
      DO 4223 II=1,ND                                                   00461400
      J=LD+14+ND-II                                                     00461500
 4223 TBSTG(J+NW2)=TBSTG(J)                                             00461600
      NE=NE+2                                                           00461700
      IBSTG(LD+2)=NE                                                    00461800
      DO 4226 II=1,NW1                                                  00461900
      J=LD+13+II                                                        00462000
      TBSTG(J)=0.0                                                      00462100
      TBSTG(J+NW1)=0.0                                                  00462200
      IF (II.GT.1) GO TO 4226                                           00462300
      TBSTG(J)=TBSTG(J+NW2)-OFST                                        00462400
      TBSTG(J+NW1)=TBSTG(J+NW2)                                         00462500
 4226 CONTINUE                                                          00462600
 4230 NLD=LD+NW-1                                                       00462700
      WRITE (6,300) NOTB,(TBID(J,NTBS),J=1,14),NCASE,NE                 00462800
      IF (NW.GT.1) WRITE (6,310) (TBSTG(J+7),J=LD,NLD)                  00462900
      IIW=INBR+NW+1                                                     00463000
      FMT(3)=FIW                                                        00463100
      NLD=LD+NE*NW1-1                                                   00463200
      WRITE (6,FMT) (TBSTG(J+14),J=LD,NLD)                              00463300
 4290 CONTINUE                                                          00463400
C                                                                       00463500
C     MISSING TABLES                                                    00463600
 5000 IF (NTB.EQ.0) GO TO 9000                                          00463700
      WRITE (6,500) (IDTA(I),I=1,NTB)                                   00463800
      STOP                                                              00463900
C                                                                       00464000
C     EXIT                                                              00464100
 9000 RETURN                                                            00464200
      END                                                               00464300
*DECK COPT                                                              00464301
C     SUBROUTINE COPT OF PROGRAM XF0031                                 00464400
C     L.W. FESLER     41-383/530  X4263                                 00464500
C                                                                       00464600
C                *****      *****      *****      *****                 00464700
C                                                                       00464800
C     THIS SUBROUTINE CREATES A COMPOSITE TABLE CONSISTING OF           00464900
C     ORBITER-ASCENT + ORBITER-ENTRY DATA.                              00465000
C                                                                       00465100
C                *****      *****      *****      *****                 00465200
C                                                                       00465300
C     LIST OF ARGUMENTS                                                 00465400
C       OFST - ENTRY TIME                                               00465500
C       DATT - DATA ARRAY                                               00465600
C                                                                       00465700
C                *****      *****      *****      *****                 00465800
C                                                                       00465900
      SUBROUTINE COPT(OFST,DATT)                                        00466000
C                                                                       00466100
      DIMENSION DATT(1760),DATA(880),DATE(880),ARY(1746),ARA(866),      00466200
     1          ARE(866),IA(14),IE(14),STX(7),STY(7)                    00466300
C                                                                       00466400
      EQUIVALENCE (DATA(1),IA(1)),(DATE(1),IE(1)),                      00466500
     1            (DATA(15),ARA(1)),(DATE(15),ARE(1)),(FDD,IDD)         00466600
C                                                                       00466700
  100 DO 105 I=1,880                                                    00466800
      DATA(I)=DATT(I+880)                                               00466900
  105 DATE(I)=DATT(I)                                                   00467000
      NT=IE(3)                                                          00467100
      LD=0                                                              00467200
      LA=0                                                              00467300
      LE=0                                                              00467400
      DO 180 I=1,NT                                                     00467500
      NC=IE(I+3)                                                        00467600
      NCA=IA(I+3)                                                       00467700
      NEA=IA(I+8)                                                       00467800
      NEE=IE(I+8)                                                       00467900
      NA=NEA-1                                                          00468000
      IDD=NA+NEE+1                                                      00468100
      DATT(I+8)=FDD                                                     00468200
      DO 110 J=1,NC                                                     00468300
  110 DATT(LD+J+14)=ARE(LE+J)                                           00468400
      DO 115 J=1,NCA                                                    00468500
  115 STX(J)=ARA(LA+J)                                                  00468600
      LDO=LD                                                            00468700
      DO 140 K=1,NA                                                     00468800
      LD=LD+NC+1                                                        00468900
      LA=LA+NCA+1                                                       00469000
      DATT(LD+14)=ARA(LA)                                               00469100
      DO 120 L=1,NCA                                                    00469200
  120 STY(L)=ARA(LA+L)                                                  00469300
      DO 130 L=1,NC                                                     00469400
      DATT(LD+L+14)=ARA(LA+L)                                           00469500
      IF (NCA.EQ.1) GO TO 130                                           00469600
      IF (L.GT.NCA) GO TO 125                                           00469601
      IF (STX(L).EQ.DATT(LDO+L+14)) GO TO 130                           00469700
  125 DATT(LD+L+14)=FNSP(1,3,NCA,DATT(LDO+L+14),STX,STY)                00469800
  130 CONTINUE                                                          00469900
  140 CONTINUE                                                          00470000
      LA=LA+NCA+NCA+1                                                   00470100
      DO 160 K=1,NEE                                                    00470200
      LD=LD+NC+1                                                        00470300
      LE=LE+NC+1                                                        00470400
      IF (K.GT.1) GO TO 146                                             00470500
      DATT(LD+14)=ARE(LE)+OFST                                          00470600
      DO 143 L=1,NC                                                     00470700
  143 DATT(LD+L+14)=0.0                                                 00470800
      LD=LD+NC+1                                                        00470900
  146 DATT(LD+14)=ARE(LE)+OFST                                          00471000
      DO 150 L=1,NC                                                     00471100
  150 DATT(LD+L+14)=ARE(LE+L)                                           00471200
  160 CONTINUE                                                          00471300
      IF (DATT(LD+14).GT.99999.0) DATT(LD+14)=99999.0                   00471400
      LD=LD+NC                                                          00471500
      LE=LE+NC                                                          00471600
  180 CONTINUE                                                          00471700
  190 RETURN                                                            00471800
      END                                                               00471900
*DECK CDTA                                                              00471901
C     SUBROUTINE CDTA OF PROGRAM XF0031                                 00472000
C     L.W. FESLER     41-383/530  X4263                                 00472100
C                                                                       00472200
C                *****      *****      *****      *****                 00472300
C                                                                       00472400
C     THIS SUBROUTINE COMPUTES DATA THAT IS INDEPENDENT OF TIME.        00472500
C                                                                       00472600
C                *****      *****      *****      *****                 00472700
C                                                                       00472800
      SUBROUTINE CDTA                                                   00472900
C                                                                       00473000
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00473100
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00473200
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00473300
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00473400
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00473500
     5              ICLOCK,IDOMT,INPP(33)                               00473501
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00473600
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00473700
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00473800
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300),       00473900
     4              ICRDR,ICRDP,CORD(3,300)                             00474000
      COMMON /CMN3/ TBSTG(4000),TBID(14,99)                             00474001
      DIMENSION IBSTG(4000)                                             00474002
      EQUIVALENCE (TBSTG(1),IBSTG(1))                                   00474003
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00474100
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00474200
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00474300
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00474400
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00474500
     2              DGP2(75),PGSF(75),BQGP(75),                         00474600
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00474700
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00474800
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00474900
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00475000
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00475100
     3              FP(75,3,2),BQA(75,3,2),                             00475200
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00475300
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00475400
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00475500
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00475600
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00475700
C                                                                       00475800
      DATA IBLK / 77777777777777777777B /                               00475900
C                                                                       00476000
  100 FORMAT(1H1//1H 5X,"END OF JOB - SECTION DATA ERRORS")             00476100
  110 FORMAT(1H 5X,"SECTION",I7," HAS ZERO THICKNESS")                  00476200
  120 FORMAT(1H 5X,"SECTION",I7," HAS MORE THAN EIGHT ADJACENT",        00476300
     1" SECTIONS"/1H 10X,9I10)                                          00476400
  130 FORMAT(1H 5X,"SECTION",I7," HAS NON-EXISTING ADJACENT",           00476500
     1" SECTION",I7)                                                    00476600
  140 FORMAT(1H 5X,"SECTION",I7," HAS NON-EXISTING MATERIAL",I7)        00476700
  150 FORMAT(1H1//1H 5X,"END OF JOB - DATA ERRORS IN HEAT FLUX ",       00476701
     1       "DATA OR CONVECTION DATA")                                 00476702
  160 FORMAT(1H 5X,"NA",I4,",  TABLE NOT F(TIME) ONLY")                 00476703
  170 FORMAT(1H 5X,"NC",I4,",  TABLE NOT F(TIME) ONLY")                 00476704
  180 FORMAT(1H 5X,"NA",I4,",  ITA=10 PARAMETERS NOT SAME AS ",         00476705
     *       "ITA=2 PARAMETERS")                                        00476706
  190 FORMAT(1H 5X,"NC",I4,",  ITC=10 PARAMETERS NOT SAME AS ",         00476707
     *       "ITC=2 PARAMETERS")                                        00476708
C                                                                       00476800
C     ADJACENT SECTIONS                                                 00476900
 1000 IF (INPO(36).EQ.2) GO TO 1005                                     00477000
      IF (INRO(1).NE.1) GO TO 2000                                      00477100
 1005 DO 1010 I=1,999                                                   00477200
 1010 NSCTL(I)=0                                                        00477300
      IAJT=0                                                            00477400
      DO 1030 I=1,NSCTO                                                 00477600
      IS=NSCT(I)                                                        00477800
      NSCTL(IS)=I                                                       00477900
      IF (DX(I).EQ.0.0) GO TO 1015                                      00478000
      IF (DY(I).EQ.0.0) GO TO 1015                                      00478100
      IF (DZ(I).NE.0.0) GO TO 1020                                      00478200
 1015 IF (IAJT.EQ.0) WRITE (6,100)                                      00478300
      IAJT=1                                                            00478400
      WRITE (6,110) IS                                                  00478500
 1020 JS=0                                                              00478600
      DO 1030 J=1,8                                                     00478700
      NOSC(J,I)=0                                                       00478800
      IF (J.GT.5) GO TO 1030                                            00478900
      IF (NAJ(J,I).EQ.IBLK) GO TO 1030                                  00479000
      JS=JS+1                                                           00479100
      NOSC(JS,I)=NAJ(J,I)                                               00479200
 1030 CONTINUE                                                          00479300
      DO 1060 I=1,NSCTO                                                 00479400
      IS=NSCT(I)                                                        00479500
      DO 1060 J=1,8                                                     00479600
      JS=NOSC(J,I)                                                      00479700
      IF (JS.EQ.0) GO TO 1060                                           00479800
      ISTN=JS-10000*(JS/10000)                                          00479900
      JSCT=NSCTL(ISTN)                                                  00480000
      ISCT=JS-ISTN+IS                                                   00480100
      KDS=0                                                             00480200
      DO 1040 K=1,8                                                     00480300
      KS=NOSC(K,JSCT)                                                   00480400
      IF (KS.EQ.ISCT) GO TO 1060                                        00480500
      IF (KDS.NE.0) GO TO 1040                                          00480600
      IF (KS.EQ.0) KDS=K                                                00480700
 1040 CONTINUE                                                          00480800
      IF (KDS.NE.0) GO TO 1050                                          00480900
      IF (IAJT.EQ.0) WRITE (6,100)                                      00481000
      IAJT=1                                                            00481100
      WRITE (6,120) ISTN,(NOSC(K,JSCT),K=1,8),ISCT                      00481200
      GO TO 1060                                                        00481300
 1050 NOSC(KDS,JSCT)=ISCT                                               00481400
 1060 CONTINUE                                                          00481500
      DO 1070 I=1,NSCTO                                                 00481600
      IOSC(9,I)=0                                                       00481700
      DO 1070 J=1,8                                                     00481800
      IOSC(J,I)=0                                                       00481900
      JS=NOSC(J,I)                                                      00482000
      IF (JS.EQ.0) GO TO 1070                                           00482100
      ISTN=JS-10000*(JS/10000)                                          00482200
      ISCT=NSCTL(ISTN)                                                  00482300
      IOSC(J,I)=ISCT                                                    00482400
      IOSC(9,I)=J                                                       00482500
      IF (ISCT.NE.0) GO TO 1070                                         00482600
      IF (IAJT.EQ.0) WRITE (6,100)                                      00482700
      IAJT=1                                                            00482800
      WRITE (6,130) NSCT(I),ISTN                                        00482900
 1070 CONTINUE                                                          00483000
      DO 1080 I=1,NSCTO                                                 00483100
      IMTL=LONP(MTLN(I),NMTLO,NMTL)                                     00483200
      IF (IMTL.GT.0) GO TO 1080                                         00483300
      IF (IAJT.EQ.0) WRITE (6,100)                                      00483400
      IAJT=1                                                            00483500
      WRITE (6,140) NSCT(I),MTLN(I)                                     00483600
 1080 CONTINUE                                                          00483700
      IF (IAJT.NE.0) STOP                                               00483800
C                                                                       00483900
C     GAP                                                               00484000
 2000 IF (NGAPO.EQ.0) GO TO 3000                                        00484100
      DO 2060 I=1,NGAPO                                                 00484200
      BQGP(I)=0.0                                                       00484300
      IS=NGPI(I)                                                        00484400
      ISCT=NSCTL(IS)                                                    00484500
      DO 2010 J=1,8                                                     00484600
      JS=NOSC(J,ISCT)                                                   00484700
      ISTN=JS-10000*(JS/10000)                                          00484800
      IF (NGPJ(I).EQ.ISTN) GO TO 2020                                   00484900
 2010 CONTINUE                                                          00485000
      DD1=DGP1(I)                                                       00485100
      DD2=DGP2(I)                                                       00485200
      GO TO 2050                                                        00485300
 2020 IF (JS.GT.20000) GO TO 2030                                       00485400
      DD1=ABS(DY(ISCT))                                                 00485500
      DD2=ABS(DZ(ISCT))                                                 00485600
      GO TO 2050                                                        00485700
 2030 IF (JS.GT.30000) GO TO 2040                                       00485800
      DD1=ABS(DZ(ISCT))                                                 00485900
      DD2=ABS(DX(ISCT))                                                 00486000
      GO TO 2050                                                        00486100
 2040 DD1=ABS(DX(ISCT))                                                 00486200
      DD2=ABS(DY(ISCT))                                                 00486300
 2050 M=MSTD(2,2,2,0,0,DD1,DGP1(I))                                     00486400
      M=MSTD(2,2,2,0,0,DD2,DGP2(I))                                     00486500
      IF (DD1.GE.0.0) GO TO 2055                                        00486600
      DD1=-DD1                                                          00486700
      DD2=1.0                                                           00486800
 2055 BQGP(I)=(0.1714E-08/FTRT)*(DD1*DD2/144.0)                         00486900
 2060 CONTINUE                                                          00487000
C                                                                       00487100
C     HEAT FLUX                                                         00487200
 3000 I210T=0                                                           00487300
      I210E=0                                                           00487301
      IF (NAOO.EQ.0) GO TO 4000                                         00487302
      DO 3050 IN1=1,2                                                   00487400
      DO 3050 IN2=1,3                                                   00487500
      NAI=NAO(IN2,IN1)                                                  00487600
      IF (NAI.EQ.0) GO TO 3050                                          00487700
      DO 3040 I=1,NAI                                                   00487800
      IS=NA(I,IN2,IN1)                                                  00487900
      ISCT=NSCTL(IS)                                                    00488000
      IF (IN2.GT.1) GO TO 3010                                          00488100
      DD1=ABS(DY(ISCT))                                                 00488200
      DD2=ABS(DZ(ISCT))                                                 00488300
      GO TO 3030                                                        00488400
 3010 IF (IN2.GT.2) GO TO 3020                                          00488500
      DD1=ABS(DZ(ISCT))                                                 00488600
      DD2=ABS(DX(ISCT))                                                 00488700
      GO TO 3030                                                        00488800
 3020 DD1=ABS(DX(ISCT))                                                 00488900
      DD2=ABS(DY(ISCT))                                                 00489000
 3030 M=MSTD(2,2,2,0,0,DD1,DA(I,IN2,IN1))                               00489100
      M=MSTD(2,2,2,0,0,DD2,ZA(I,IN2,IN1))                               00489200
      BQA(I,IN2,IN1)=DD1*DD2/144.0                                      00489300
      ITAO=ITA(I,IN2,IN1)                                               00489301
      IF (ITAO.EQ.2) GO TO 3032                                         00489302
      IF (ITAO.EQ.10) GO TO 3036                                        00489303
      GO TO 3040                                                        00489304
 3032 I210T=2                                                           00489305
      VAL1=FA(I,IN2,IN1)                                                00489306
      VAL2=QA(I,IN2,IN1)                                                00489307
      VAL3=AA(I,IN2,IN1)                                                00489308
      IF (VAL2.GE.0.0) GO TO 3040                                       00489309
      TT=-VAL2                                                          00489310
      NTO=IBSTG(1)                                                      00489311
      DO 3033 J=1,NTO                                                   00489312
      NI=J                                                              00489313
      IF (TT.EQ.ABS(TBSTG(J+2))) GO TO 3034                             00489314
 3033 CONTINUE                                                          00489315
      GO TO 3035                                                        00489316
 3034 LD=IBSTG(NI+101)                                                  00489317
      NW=IBSTG(LD+3)                                                    00489318
      IF (NW.LE.1) GO TO 3040                                           00489319
 3035 IF (I210E.EQ.0) WRITE (6,150)                                     00489320
      I210E=1                                                           00489321
      WRITE (6,160) IS                                                  00489322
      GO TO 3040                                                        00489323
 3036 IF (FA(I,IN2,IN1).NE.VAL1) GO TO 3038                             00489324
      IF (QA(I,IN2,IN1).NE.VAL2) GO TO 3038                             00489325
      IF (AA(I,IN2,IN1).NE.VAL3) GO TO 3038                             00489326
      GO TO 3040                                                        00489327
 3038 IF (I210E.EQ.0) WRITE (6,150)                                     00489328
      I210E=1                                                           00489329
      WRITE (6,180) IS                                                  00489330
 3040 CONTINUE                                                          00489400
 3050 CONTINUE                                                          00489500
C                                                                       00489600
C     RERADIATION                                                       00489700
 4000 IF (NRSOO.EQ.0) GO TO 6000                                        00489800
      DO 4050 IN=1,3                                                    00489900
      NRSI=NRSO(IN)                                                     00490000
      IF (NRSI.EQ.0) GO TO 4050                                         00490100
      DO 4040 I=1,NRSI                                                  00490200
      IS=NRS(I,IN)                                                      00490300
      ISCT=NSCTL(IS)                                                    00490400
      IF (IN.GT.1) GO TO 4010                                           00490500
      DD1=ABS(DY(ISCT))                                                 00490600
      DD2=ABS(DZ(ISCT))                                                 00490700
      GO TO 4030                                                        00490800
 4010 IF (IN.GT.2) GO TO 4020                                           00490900
      DD1=ABS(DZ(ISCT))                                                 00491000
      DD2=ABS(DX(ISCT))                                                 00491100
      GO TO 4030                                                        00491200
 4020 DD1=ABS(DX(ISCT))                                                 00491300
      DD2=ABS(DY(ISCT))                                                 00491400
 4030 M=MSTD(2,2,2,0,0,DD1,DRS(I,IN))                                   00491500
      M=MSTD(2,2,2,0,0,DD2,ZRS(I,IN))                                   00491600
      BQRS(I,IN)=(0.1714E-08/FTRT)*(DD1*DD2/144.0)                      00491700
 4040 CONTINUE                                                          00491800
 4050 CONTINUE                                                          00491900
C                                                                       00492000
C     CONVECTION                                                        00492100
 6000 IF (NCOO.EQ.0) GO TO 8000                                         00492200
      I210T=0                                                           00492201
      DO 6050 IN=1,3                                                    00492300
      NCOI=NCO(IN)                                                      00492400
      IF (NCOI.EQ.0) GO TO 6050                                         00492500
      DO 6040 I=1,NCOI                                                  00492600
      IS=NC(I,IN)                                                       00492700
      ISCT=NSCTL(IS)                                                    00492800
      IF (IN.GT.1) GO TO 6010                                           00492900
      DD1=ABS(DY(ISCT))                                                 00493000
      DD2=ABS(DZ(ISCT))                                                 00493100
      GO TO 6030                                                        00493200
 6010 IF (IN.GT.2) GO TO 6020                                           00493300
      DD1=ABS(DZ(ISCT))                                                 00493400
      DD2=ABS(DX(ISCT))                                                 00493500
      GO TO 6030                                                        00493600
 6020 DD1=ABS(DX(ISCT))                                                 00493700
      DD2=ABS(DY(ISCT))                                                 00493800
 6030 M=MSTD(2,2,2,0,0,DD1,DC(I,IN))                                    00493900
      M=MSTD(2,2,2,0,0,DD2,ZC(I,IN))                                    00494000
      BQC(I,IN)=(1.0/FTRT)*(DD1*DD2/144.0)                              00494100
      ITCO=ITC(I,IN)                                                    00494101
      IF (ITCO.EQ.2) GO TO 6032                                         00494102
      IF (ITCO.EQ.10) GO TO 6036                                        00494103
      GO TO 6040                                                        00494104
 6032 I210T=2                                                           00494105
      VAL1=FC(I,IN)                                                     00494106
      VAL2=HC(I,IN)                                                     00494107
      IF (VAL2.GE.0.0) GO TO 6040                                       00494108
      TT=-VAL2                                                          00494109
      NTO=IBSTG(1)                                                      00494110
      DO 6033 J=1,NTO                                                   00494111
      NI=J                                                              00494112
      IF (TT.EQ.ABS(TBSTG(J+2))) GO TO 6034                             00494113
 6033 CONTINUE                                                          00494114
      GO TO 6035                                                        00494115
 6034 LD=IBSTG(NI+101)                                                  00494116
      NW=IBSTG(LD+3)                                                    00494117
      IF (NW.LE.1) GO TO 6040                                           00494118
 6035 IF (I210E.EQ.0) WRITE (6,150)                                     00494119
      I210E=1                                                           00494120
      WRITE (6,170) IS                                                  00494121
      GO TO 6040                                                        00494122
 6036 IF (FC(I,IN).NE.VAL1) GO TO 6038                                  00494123
      IF (HC(I,IN).NE.VAL2) GO TO 6038                                  00494124
      GO TO 6040                                                        00494125
 6038 IF (I210E.EQ.0) WRITE (6,150)                                     00494126
      I210E=1                                                           00494127
      WRITE (6,190) IS                                                  00494128
 6040 CONTINUE                                                          00494200
 6050 CONTINUE                                                          00494300
C                                                                       00494400
C     COEFFICIENTS                                                      00494500
 8000 DO 8010 I=1,NSCTO                                                 00494600
      DO 8010 J=1,8                                                     00494700
 8010 BCOET(J,I)=0.0                                                    00494800
      DO 8080 I=1,NSCTO                                                 00494900
      ISII=NSCT(I)                                                      00495000
      DO 8080 J=1,8                                                     00495100
      IF (BCOET(J,I).NE.0.0) GO TO 8080                                 00495200
      ISCT=NOSC(J,I)                                                    00495300
      IF (ISCT.LE.0) GO TO 8080                                         00495400
      IF (ISCT.GT.30999) GO TO 8080                                     00495500
      ISTN=ISCT-10000*(ISCT/10000)                                      00495600
      IS=NSCTL(ISTN)                                                    00495700
      IF (ISCT.GT.20000) GO TO 8020                                     00495800
      DD1=AMIN1(ABS(DY(I)),ABS(DY(IS)))                                 00495900
      DD2=AMIN1(ABS(DZ(I)),ABS(DZ(IS)))                                 00496000
      GO TO 8040                                                        00496100
 8020 IF (ISCT.GT.30000) GO TO 8030                                     00496200
      DD1=AMIN1(ABS(DZ(I)),ABS(DZ(IS)))                                 00496300
      DD2=AMIN1(ABS(DX(I)),ABS(DX(IS)))                                 00496400
      GO TO 8040                                                        00496500
 8030 DD1=AMIN1(ABS(DX(I)),ABS(DX(IS)))                                 00496600
      DD2=AMIN1(ABS(DY(I)),ABS(DY(IS)))                                 00496700
 8040 IF (NOFSO.EQ.0) GO TO 8050                                        00496800
      IOFS=LOAP(ISII,ISTN,NOFSO,NOFI,NOFJ)                              00496900
      IF (IOFS.EQ.0) IOFS=LOAP(ISTN,ISII,NOFSO,NOFI,NOFJ)               00497000
      IF (IOFS.EQ.0) GO TO 8050                                         00497100
      M=MSTD(2,2,2,0,0,DD1,OFL1(IOFS))                                  00497200
      M=MSTD(2,2,2,0,0,DD2,OFL2(IOFS))                                  00497300
 8050 BCOET(J,I)=(1.0/FTRT)*(DD1*DD2*2.0/12.0)                          00497400
      DO 8060 K=1,8                                                     00497500
      JS=K                                                              00497600
      ISTN=NOSC(K,IS)-10000*(NOSC(K,IS)/10000)                          00497700
      IF (ISII.EQ.ISTN) GO TO 8070                                      00497800
 8060 CONTINUE                                                          00497900
      GO TO 8080                                                        00498000
 8070 IF (BCOET(JS,IS).EQ.0.0) BCOET(JS,IS)=BCOET(J,I)                  00498100
 8080 CONTINUE                                                          00498200
      IF (I210E.NE.0) STOP                                              00498201
C                                                                       00498300
C     EXIT                                                              00498400
 9000 RETURN                                                            00498500
      END                                                               00498600
*DECK RIFA                                                              00498601
C     SUBROUTINE RIFA OF PROGRAM XF0031                                 00498700
C     L.W. FESLER     41-383/530  X4263                                 00498800
C                                                                       00498900
C                *****      *****      *****      *****                 00499000
C                                                                       00499100
C     THIS SUBROUTINE SOLVES THE RADIATION INTERCHANGE ENCLOSURES       00499200
C     FOR SCRIPT FA FACTORS.                                            00499300
C                                                                       00499400
C                *****      *****      *****      *****                 00499500
C                                                                       00499600
      SUBROUTINE RIFA                                                   00499700
C                                                                       00499800
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00499900
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00500000
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00500100
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00500200
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00500300
     5              ICLOCK,IDOMT,INPP(33)                               00500301
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00500400
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00500500
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00500600
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300),       00500700
     4              ICRDR,ICRDP,CORD(3,300)                             00500800
      COMMON /CMN7/ NRIO(3,2),NRI(25,3,2),ERI(25,3,2),DRI(25,3,2),      00500900
     1              ZRI(25,3,2),NAVT(2),BVT(40,40,2),NBVT(40,2),        00501000
     2              NVFO(2),NVFI(750,2),NVFJ(750,2),VFIJ(750,2),SFAS(2) 00501100
      DIMENSION IBVT(40,40,2)                                           00501200
      EQUIVALENCE (BVT(1,1,1),IBVT(1,1,1))                              00501300
      COMMON /CMN8/ CAP(5408)                                           00501400
C                                                                       00501500
      DIMENSION AREA(40),EMIS(40),VF(40,40),CF(40,40),DF(40,40),        00501600
     1CNST(40,40),NROW(40),IDTA(40),NCOL(40)                            00501700
      EQUIVALENCE (CF(1,1),CAP(1)),(DF(1,1),CAP(1601)),                 00501800
     1            (CNST(1,1),CAP(3201))                                 00501900
C                                                                       00502000
  100 FORMAT(1H15X,"MORE THAN ONE DIRECTION IS SPECIFIED FOR SECTION",  00502100
     1I5," IN RADIATION INTERCHANGE ENCLOSURE",I2)                      00502200
  300 FORMAT(1H15X,"RADIATION INTERCHANGE SCRIPT FA   --ENCLOSURE",     00502300
     1I2,"--"/1H 5X,"NCASE",I4///1H 5X,"SECTI",3X,"SECTJ",5X,           00502400
     2"EMISI",5X,"AREAI",6X,"VFIJ",5X,"EMISJ",5X,"AREAJ",6X,"VFJI",     00502500
     35X,"SCRIPT FA")                                                   00502600
  110 FORMAT(1H15X,"MORE THAN 40 SURFACES HAVE BEEN SPECIFIED FOR "     00502700
     1"RADIATION INTERCHANGE ENCLOSURE",I2)                             00502800
  310 FORMAT(1H 5X,I5,I8,6F10.4,F14.5)                                  00502900
C                                                                       00503000
C     INITIALIZE ENCLOSURE                                              00503100
 1000 DO 3900 IN1=1,2                                                   00503200
      NAVT(IN1)=0                                                       00503300
      IF (NVFO(IN1).EQ.0) GO TO 3900                                    00503400
      NAVTO=0                                                           00503500
      DO 1060 IN2=1,3                                                   00503600
      NRII=NRIO(IN2,IN1)                                                00503700
      IF (NRII.EQ.0) GO TO 1060                                         00503800
      DO 1050 I=1,NRII                                                  00503900
      NVT=NRI(I,IN2,IN1)                                                00504000
      NVTO=LONP(NVT,NAVTO,NBVT(1,IN1))                                  00504100
      IF (NVTO.EQ.0) GO TO 1010                                         00504200
      WRITE (6,100) NVT,IN1                                             00504300
      GO TO 1050                                                        00504400
 1010 NAVTO=NAVTO+1                                                     00504500
      NBVT(NAVTO,IN1)=NVT                                               00504600
      ISCT=NSCTL(NVT)                                                   00504700
      IF (IN2.GT.1) GO TO 1020                                          00504800
      DD1=ABS(DY(ISCT))                                                 00504900
      DD2=ABS(DZ(ISCT))                                                 00505000
      GO TO 1040                                                        00505100
 1020 IF (IN2.GT.2) GO TO 1030                                          00505200
      DD1=ABS(DZ(ISCT))                                                 00505300
      DD2=ABS(DX(ISCT))                                                 00505400
      GO TO 1040                                                        00505500
 1030 DD1=ABS(DX(ISCT))                                                 00505600
      DD2=ABS(DY(ISCT))                                                 00505700
 1040 M=MSTD(2,2,2,0,0,DD1,DRI(I,IN2,IN1))                              00505800
      M=MSTD(2,2,2,0,0,DD2,ZRI(I,IN2,IN1))                              00505900
      AREA(NAVTO)=DD1*DD2                                               00506000
      EMIS(NAVTO)=ERI(I,IN2,IN1)                                        00506100
 1050 CONTINUE                                                          00506200
 1060 CONTINUE                                                          00506300
      IF (NAVTO.LE.40) GO TO 1100                                       00506400
      WRITE (6,110) IN1                                                 00506500
      STOP                                                              00506600
 1100 NAVT(IN1)=NAVTO                                                   00506700
      NBVTO=NAVTO-1                                                     00506800
      DO 1110 I=1,NBVTO                                                 00506900
      IJ=I+1                                                            00507000
      IDUM=NBVT(I,IN1)                                                  00507100
      DUMA=AREA(I)                                                      00507200
      DUME=EMIS(I)                                                      00507300
      DO 1110 J=IJ,NAVTO                                                00507400
      IF (IDUM.LT.NBVT(J,IN1)) GO TO 1110                               00507500
      NBVT(I,IN1)=NBVT(J,IN1)                                           00507600
      AREA(I)=AREA(J)                                                   00507700
      EMIS(I)=EMIS(J)                                                   00507800
      AREA(J)=DUMA                                                      00507900
      EMIS(J)=DUME                                                      00508000
      NBVT(J,IN1)=IDUM                                                  00508100
      IDUM=NBVT(I,IN1)                                                  00508200
      DUMA=AREA(I)                                                      00508300
      DUME=EMIS(I)                                                      00508400
 1110 CONTINUE                                                          00508500
 1200 DO 1210 I=1,NAVTO                                                 00508600
      DO 1210 J=1,NAVTO                                                 00508700
      VF(I,J)=0.0                                                       00508800
      BVT(I,J,IN1)=0.0                                                  00508900
 1210 CONTINUE                                                          00509000
      DO 1220 I=1,NAVTO                                                 00509100
      IS=NBVT(I,IN1)                                                    00509200
      DO 1220 J=1,NAVTO                                                 00509300
      JS=NBVT(J,IN1)                                                    00509400
      IVF=LOAP(IS,JS,NVFO(IN1),NVFI(1,IN1),NVFJ(1,IN1))                 00509500
      IF (IVF.EQ.0) GO TO 1220                                          00509600
      VF(I,J)=VFIJ(IVF,IN1)                                             00509700
      IF (VF(J,I).NE.0.0) GO TO 1220                                    00509800
      VF(J,I)=AREA(I)*VF(I,J)/AREA(J)                                   00509900
 1220 CONTINUE                                                          00510000
 1300 DO 1320 I=1,NAVTO                                                 00510100
      IF (VF(I,I).NE.0.0) GO TO 1320                                    00510200
      SUM=0.0                                                           00510300
      DO 1310 J=1,NAVTO                                                 00510400
      SUM=SUM+VF(I,J)                                                   00510500
 1310 CONTINUE                                                          00510600
      VF(I,I)=1.0-SUM                                                   00510700
 1320 CONTINUE                                                          00510800
C                                                                       00510900
C     SOLVE ENCLOSURE                                                   00511000
 2000 NROWO=0                                                           00511100
      DO 2010 I=1,NAVTO                                                 00511200
      IF (ABS(EMIS(I)-1.0).LT.0.001) GO TO 2010                         00511300
      NROWO=NROWO+1                                                     00511400
      NROW(NROWO)=NBVT(I,IN1)                                           00511500
 2010 CONTINUE                                                          00511600
      IF (NROWO.EQ.0) GO TO 2100                                        00511700
      DO 2020 J=1,NROWO                                                 00511800
      JS=LONP(NROW(J),NAVTO,NBVT(1,IN1))                                00511900
      DO 2020 K=1,NROWO                                                 00512000
      KS=LONP(NROW(K),NAVTO,NBVT(1,IN1))                                00512100
      IF (KS.NE.JS) CF(J,K)=VF(JS,KS)                                   00512200
      IF (KS.EQ.JS) CF(J,K)=VF(JS,KS)-1.0/(1.0-EMIS(JS))                00512300
      IF (ABS(CF(J,K)).LT.0.00001) CF(J,K)=0.0                          00512400
      DF(J,K)=CF(J,K)                                                   00512500
 2020 CONTINUE                                                          00512600
      NCOLO=0                                                           00512700
      DO 2030 I=1,NAVTO                                                 00512800
      IF (EMIS(I).EQ.0.0) GO TO 2030                                    00512900
      NCOLO=NCOLO+1                                                     00513000
      NCOL(NCOLO)=NBVT(I,IN1)                                           00513100
      DO 2025 J=1,NROWO                                                 00513200
      JS=LONP(NROW(J),NAVTO,NBVT(1,IN1))                                00513300
      CNST(J,NCOLO)=-VF(JS,I)*EMIS(I)                                   00513400
      IF (ABS(CNST(J,NCOLO)).LT.0.00001) CNST(J,NCOLO)=0.0              00513500
 2025 CONTINUE                                                          00513600
 2030 CONTINUE                                                          00513700
      NB=NCOLO-NROWO                                                    00513800
      NCLL=NCOLO                                                        00513900
      IF (NCLL.GT.NROWO) NCLL=NROWO                                     00514000
      DMY=1.0                                                           00514100
      M=ISIMEQ(40,NROWO,NCLL,CF,CNST,DMY,IDTA)                          00514200
      IF (NB.LE.0) GO TO 2035                                           00514300
      NCLL=NCLL+1                                                       00514400
      M=ISIMEQ(40,NROWO,NB,DF,CNST(1,NCLL),DMY,IDTA)                    00514500
      DO 2033 I=1,NB                                                    00514600
      IJ=NCLL+I-1                                                       00514700
      DO 2033 J=1,NROWO                                                 00514800
 2033 CF(J,IJ)=DF(J,I)                                                  00514900
 2035 DO 2050 I=1,NAVTO                                                 00515000
      IF (EMIS(I).EQ.0.0) GO TO 2050                                    00515100
      IS=NBVT(I,IN1)                                                    00515200
      ISCT=LONP(IS,NCOLO,NCOL)                                          00515300
      IF (ISCT.EQ.0) GO TO 2050                                         00515400
      DO 2040 J=1,NAVTO                                                 00515500
      IF (BVT(I,J,IN1).NE.0.0) GO TO 2040                               00515600
      JS=NBVT(J,IN1)                                                    00515700
      JSCT=LONP(JS,NROWO,NROW)                                          00515800
      IF (JSCT.EQ.0) GO TO 2040                                         00515900
      BVT(I,J,IN1)=CF(JSCT,ISCT)*AREA(J)*(EMIS(J)/(1.0-EMIS(J)))        00516000
      IF (BVT(J,I,IN1).EQ.0.0) BVT(J,I,IN1)=BVT(I,J,IN1)                00516100
 2040 CONTINUE                                                          00516200
 2050 CONTINUE                                                          00516300
 2100 DO 2120 I=1,NAVTO                                                 00516400
      DO 2120 J=1,NAVTO                                                 00516500
      IF (ABS(EMIS(I)-1.0).GT.0.001) GO TO 2120                         00516600
      IF (ABS(EMIS(J)-1.0).GT.0.001) GO TO 2120                         00516700
      BVT(I,J,IN1)=AREA(J)*VF(J,I)                                      00516800
      DO 2110 K=1,NAVTO                                                 00516900
      IF (EMIS(K).EQ.0.0) GO TO 2110                                    00517000
      BVT(I,J,IN1)=BVT(I,J,IN1)+(AREA(J)*VF(J,K)*BVT(I,K,IN1)/AREA(K))* 00517100
     1((1.0-EMIS(K))/EMIS(K))                                           00517200
 2110 CONTINUE                                                          00517300
 2120 CONTINUE                                                          00517400
C                                                                       00517500
C     SCRIPT FA                                                         00517600
 3000 IPNTO=IABS(INPO(35))                                              00517700
      IF (INPP(1).GT.1) IPNTO=1                                         00517701
      DO 3005 I=1,4                                                     00517702
      IS=14+(IN1-1)*4+I                                                 00517703
      IF (INPP(IS).GT.1) IPNTO=1                                        00517704
 3005 CONTINUE                                                          00517705
      IF (NCASE.EQ.1) IPNTO=1                                           00517706
      IF (IPNTO.GT.99) GO TO 3015                                       00517707
      WRITE (6,300) IN1,NCASE                                           00517708
      DO 3010 I=1,NAVTO                                                 00517800
      WRITE (6,310) (NBVT(I,IN1),NBVT(J,IN1),EMIS(I),AREA(I),           00517900
     1VF(I,J),EMIS(J),AREA(J),VF(J,I),BVT(I,J,IN1),J=I,NAVTO)           00518000
 3010 CONTINUE                                                          00518100
 3015 SFAM=SFAS(IN1)                                                    00518200
      IF (SFAM.EQ.0.0) GO TO 3100                                       00518300
      IFG1=0                                                            00518400
      NBVTO=NAVTO                                                       00518500
      NAVTO=0                                                           00518600
      DO 3040 I=1,NBVTO                                                 00518700
      NROW(I)=NBVT(I,IN1)                                               00518800
      IFG2=0                                                            00518900
      DO 3030 J=1,NBVTO                                                 00519000
      CF(I,J)=BVT(I,J,IN1)                                              00519100
      DF(I,J)=VF(I,J)                                                   00519200
      IF (CF(I,J).GT.SFAM) GO TO 3020                                   00519300
      IFG1=1                                                            00519400
      CF(I,J)=0.0                                                       00519500
      GO TO 3030                                                        00519600
 3020 IFG2=1                                                            00519700
 3030 CONTINUE                                                          00519800
      IF (IFG2.EQ.0) GO TO 3040                                         00519900
      NAVTO=NAVTO+1                                                     00520000
      NBVT(NAVTO,IN1)=NBVT(I,IN1)                                       00520100
 3040 CONTINUE                                                          00520200
      IF (IFG1.EQ.0) GO TO 3100                                         00520300
      DO 3060 I=1,NAVTO                                                 00520400
      IS=NBVT(I,IN1)                                                    00520500
      ISCT=LONP(IS,NBVTO,NROW)                                          00520600
      EMIS(I)=EMIS(ISCT)                                                00520700
      AREA(I)=AREA(ISCT)                                                00520800
      DO 3060 J=1,NAVTO                                                 00520900
      JS=NBVT(J,IN1)                                                    00521000
      JSCT=LONP(JS,NBVTO,NROW)                                          00521100
      BVT(I,J,IN1)=CF(ISCT,JSCT)                                        00521200
      VF(I,J)=DF(ISCT,JSCT)                                             00521300
 3060 CONTINUE                                                          00521400
 3080 NAVT(IN1)=NAVTO                                                   00521500
      IF (IPNTO.GT.99) GO TO 3100                                       00521501
      WRITE (6,300) IN1,NCASE                                           00521600
      IF (NAVTO.EQ.0) GO TO 3100                                        00521700
      DO 3090 I=1,NAVTO                                                 00521800
      WRITE (6,310) (NBVT(I,IN1),NBVT(J,IN1),EMIS(I),AREA(I),           00521900
     1VF(I,J),EMIS(J),AREA(J),VF(J,I),BVT(I,J,IN1),J=I,NAVTO)           00522000
 3090 CONTINUE                                                          00522100
 3100 FTR=(0.1714E-08/144.0)/FTRT                                       00522200
      DO 3110 I=1,NAVTO                                                 00522300
      IS=I                                                              00522400
      DO 3110 J=IS,NAVTO                                                00522500
      BVT(I,J,IN1)=FTR*BVT(I,J,IN1)                                     00522600
 3110 CONTINUE                                                          00522700
 3200 SFTOL=SFAS(IN1)                                                   00522800
      IF (SFTOL.EQ.0.0) SFTOL=1.0E-06                                   00522900
      SFTOL=SFTOL*FTR                                                   00523000
      DO 3250 I=1,NAVTO                                                 00523100
      NSF=0                                                             00523200
      IS=NBVT(I,IN1)                                                    00523300
      ISCT=NSCTL(IS)                                                    00523400
      IF (ISCT.EQ.0) GO TO 3240                                         00523500
      NBVT(I,IN1)=ISCT                                                  00523600
      IS=I+1                                                            00523700
      IF (IS.GT.NAVTO) GO TO 3240                                       00523800
      DO 3230 J=IS,NAVTO                                                00523900
      BVTO=BVT(I,J,IN1)                                                 00524000
      IF (BVTO.LT.SFTOL) GO TO 3230                                     00524100
 3220 NSF=NSF+1                                                         00524200
      NSFF=NSF+IS-1                                                     00524300
      IBVT(NSFF,I,IN1)=J                                                00524400
 3230 CONTINUE                                                          00524500
 3240 IBVT(I,I,IN1)=NSF                                                 00524600
 3250 CONTINUE                                                          00524700
C                                                                       00524800
 3900 CONTINUE                                                          00524900
C                                                                       00525000
C     EXIT                                                              00525100
 9000 RETURN                                                            00525200
      END                                                               00525300
*DECK TLOP                                                              00525301
C     SUBROUTINE TLOP OF PROGRAM XF0031                                 00525400
C     L.W. FESLER     41-383/530  X4263                                 00525500
C                                                                       00525600
C                *****      *****      *****      *****                 00525700
C                                                                       00525800
C     THIS SUBROUTINE SETS UP THE TIME LOOP.                            00525900
C                                                                       00526000
C                *****      *****      *****      *****                 00526100
C                                                                       00526200
      SUBROUTINE TLOP                                                   00526300
C                                                                       00526400
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00526500
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00526600
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00526700
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00526800
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00526900
     5              ICLOCK,IDOMT,INPP(33)                               00526901
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00527000
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00527100
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00527200
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300),       00527300
     4              ICRDR,ICRDP,CORD(3,300)                             00527400
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00527500
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00527600
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00527700
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00527800
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00527900
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00528000
     3              FP(75,3,2),BQA(75,3,2),                             00528100
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00528200
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00528300
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00528400
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00528500
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00528600
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00528700
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00528800
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL,            00528900
     3              IMET(300),ICOET(8,300)                              00529000
      COMMON /CMN9/ NCRTO(5),NCRT(11,50,5),NCSEO,NCSE(300),NCSSO,       00529100
     1              NCSS(99),NCPT(99),NHLDO,NHLD(300),NHRTO,NHRT(300)   00529200
      COMMON /CMNS/ NSIZE,STEMP(10),SDRAT(10),STIME(10),ISIZE,TSZO,     00529300
     1              SIZET,DEGSZ,NODSZ,METSZ,IDRSZ,IPNSZ,ITRSZ           00529400
C                                                                       00529500
      COMMON /CMNX/ QGPT(75),QTOL(300),PCR(300),IDTA(300),CAPO(300),    00529600
     1              TOSC,DELPO,DMTXT,IOSS,ITME,IRCT,DELTM,TMAVG,        00529700
     2              NQDTO,NQDT(300),QDT(8)                              00529701
      COMMON /CMNY/ TT1,TT2,TT3,TT4,TT5,TT6                             00529800
      COMMON /CMNI/ INVHF,INVH(3,2)                                     00529900
C                                                                       00530000
      DATA IBLK / 77777777777777777777B /                               00530100
C                                                                       00530200
  100 FORMAT(1H15X,"TEMPERATURE VERSUS TIME DATA"/1H 5X, "NCASE",I4)    00530300
  110 FORMAT(1H15X,"TEMPERATURE VERSUS TIME DATA",50X,                  00530400
     1"SIZING PASS",I5/1H 5X,"NCASE",I4)                                00530500
  700 FORMAT(1H05X,"NCASE",I4,5X,15A4)                                  00530600
  800 FORMAT(1H 5X,"TIMEP=",F12.5," ,    RCTIME(",I3,")=",F10.5,        00530700
     1" ,  ISTEP=",I6," ,  ITER=",I6," ,  CLOCK=",F8.4/                 00530800
     2(1H 5X,5(I4,"=",F10.3,5X)))                                       00530900
  810 FORMAT(1H05X,"TIMEP=",F12.5,10X,"PHASE CHANGE RATIOS (WI-W)/WI")  00531000
  820 FORMAT(1H 5X,"TRANSITION",I4/(1H 5X,5(I4,"=",F10.3,5X)))          00531100
  830 FORMAT(1H05X,"***** THE PRINT INTERVAL IS NOT AN EVEN ",          00531200
     1       "MULTIPLE OF THE CALCULATION INTERVAL **************",     00531300
     2       "**********"/1H 11X,"TIME=",F12.5,",     DELTC=",          00531400
     3       F12.5,",     DELTP=",F12.5)                                00531500
C                                                                       00531600
C     INITIALIZE TIME LOOP                                              00531700
 1000 REWIND 2                                                          00531800
      REWIND 3                                                          00531900
      REWIND 4                                                          00532000
      REWIND 8                                                          00532100
      REWIND 9                                                          00532200
      NSPTO=0                                                           00532300
      NQDTO=0                                                           00532301
      NOPT=0                                                            00532400
      TMEX=0.0                                                          00532500
      IPTT=INPO(35)                                                     00532600
      IF (IPTT.EQ.IBLK) IPTT=0                                          00532700
      IPNT=IABS(IPTT)                                                   00532800
      IF (IPNT.GT.99) IPNT=IPNT-100                                     00532801
      IF (IPNT.GT.3) IPNT=0                                             00532900
      ICAPT=0                                                           00533000
      IOST=0                                                            00533100
      IOSS=0                                                            00533200
      IOSN=0                                                            00533300
      ITER=0                                                            00533400
      ITME=0                                                            00533500
      IBDM=0                                                            00533600
      IADR=1                                                            00533700
      IF (FTRN.EQ.2.0) IADR=0                                           00533800
      TIMEC=TIMEO                                                       00533900
      TIMEP=TIMEO                                                       00534000
      DMTXT=DMTX/20.0                                                   00534100
      TOSC=DMTX/60.0                                                    00534200
      DELTO=0.0                                                         00534300
      DELTC=TBLP(DELT,TIMEO,0.0,ITME)                                   00534400
      DO 1090 I=1,NSCTO                                                 00534500
      TN(I)=TO(I)                                                       00534600
      TL(I)=TO(I)                                                       00534700
      TL1(I)=TO(I)                                                      00534800
      TL2(I)=TO(I)                                                      00534900
      IDLT(I)=0                                                         00535000
      IMTL=LONP(MTLN(I),NMTLO,NMTL)                                     00535100
      IMET(I)=IMTL                                                      00535200
      CAPO(I)=ABS(DX(I)*DY(I)*DZ(I))/1728.0                             00535300
      CAP(I)=CAPO(I)                                                    00535400
      IDUM=0                                                            00535500
      RHOH=TBLP(RHO(IMTL),TL(I),0.0,IDUM)                               00535600
      CPP=TBLP(CP(IMTL),TL(I),0.0,IDUM)                                 00535700
      IF (IDUM.NE.0) ICAPT=1                                            00535800
      IF (IDUM.NE.0) GO TO 1020                                         00535900
      CAP(I)=CAPO(I)*RHOH*CPP                                           00536000
      CAPO(I)=0.0                                                       00536100
 1020 QTOT(I)=0.0                                                       00536200
      QTOL(I)=0.0                                                       00536300
      PCR(I)=0.0                                                        00536400
      IFTP(I)=0                                                         00536500
      IPCT(I)=0                                                         00536600
      IF (IPRNT(I).LE.0) GO TO 1080                                     00536700
      IF (IPRNT(I).EQ.2) GO TO 1040                                     00536701
      NSPTO=NSPTO+1                                                     00536800
      NSPT(NSPTO)=NSCT(I)                                               00536900
      IF (IPRNT(I).EQ.1) GO TO 1080                                     00536901
 1040 NQDTO=NQDTO+1                                                     00536902
      NQDT(NQDTO)=NSCT(I)                                               00536903
 1080 IF (NPCMO.EQ.0) GO TO 1090                                        00537000
      IMTP=LONP(MTLN(I),NPCMO,NPCM)                                     00537100
      IF (IMTP.GT.0) IPCT(I)=1                                          00537200
 1090 CONTINUE                                                          00537300
      IF (IPTT.LT.0) GO TO 1095                                         00537400
      IF (IPNT.EQ.1.OR.IPNT.EQ.2) NSPTO=0                               00537500
 1095 ICOND=-1                                                          00537600
      CALL COND                                                         00537700
 1100 IF (NKTO.EQ.0) GO TO 1200                                         00537800
      DO 1110 I=1,NKTO                                                  00537900
      IS=NKT(I)                                                         00538000
      ISCT=NSCTL(IS)                                                    00538100
      IFTP(ISCT)=1                                                      00538200
      TVLE=TNKT(I)                                                      00538300
      IF (TVLE.LT.-460.0) TVLE=TBLP(TNKT(I),TIMEC,0.0,IDUM)             00538400
      IF (TVLE.LT.-460.0) GO TO 1103                                    00538500
      IF (INKT(I).GT.0) GO TO 1105                                      00538600
      IF (TNKT(I).EQ.0.0) GO TO 1110                                    00538700
      IF (TNKT(I).GE.-460.0) TN(ISCT)=TNKT(I)                           00538800
      IF (TNKT(I).LT.-460.0) TN(ISCT)=TVLE                              00538900
      GO TO 1110                                                        00539000
 1103 IFTP(ISCT)=3                                                      00539100
      GO TO 1110                                                        00539200
 1105 JS=INKT(I)                                                        00539300
      JSCT=NSCTL(JS)                                                    00539400
      TN(ISCT)=TL(JSCT)                                                 00539500
 1110 CONTINUE                                                          00539600
 1200 IF (FTRN.EQ.0.0) GO TO 1300                                       00539700
      IF (FTRN.GT.1.0) GO TO 1300                                       00539800
      TOLR1=TOLR                                                        00539900
      TOLRE=100.0*TOLR                                                  00540000
      FTRM=1.0                                                          00540100
 1300 IF (NCRTO(1).EQ.0) GO TO 1400                                     00540200
      IF (NCASE.EQ.1) NCSSO=0                                           00540300
      IF (NCSSO.EQ.0) GO TO 1340                                        00540400
      DO 1330 I=1,NCSSO                                                 00540500
      READ (4) NCBR,IDUM,IDUM                                           00540600
      NOPP=NCPT(I)                                                      00540700
      DO 1330 J=1,NOPP                                                  00540800
      READ (4) DUM                                                      00540900
 1330 CONTINUE                                                          00541000
 1340 NCSSO=NCSSO+1                                                     00541100
      NCSS(NCSSO)=NCASE                                                 00541200
      WRITE (4) NCSSO,NCASE,NCSEO,(NCSE(I),I=1,NCSEO)                   00541300
 1400 IF (IPNT.EQ.2) GO TO 1500                                         00541400
      IF (ISIZE.GT.0.AND.IPNSZ.EQ.0) GO TO 1500                         00541500
      IF (ISIZE.EQ.0) WRITE (6,100) NCASE                               00541600
      IF (ISIZE.GT.0) WRITE (6,110) NSIZE,NCASE                         00541700
 1500 IF (ISIZE.EQ.0) GO TO 1600                                        00541800
      NDSZL=NSCTL(NODSZ)                                                00541900
      TSZO=TL(NDSZL)                                                    00542000
      STEMP(NSIZE)=-500.0                                               00542100
      STIME(NSIZE)=TIMEC                                                00542200
 1600 INVHF=0                                                           00542300
      DO 1620 IN1=1,2                                                   00542400
      DO 1620 IN2=1,3                                                   00542500
      NAI=NAO(IN2,IN1)                                                  00542600
      IF (NAI.EQ.0) GO TO 1620                                          00542700
      INVH(IN2,IN1)=0                                                   00542800
      DO 1610 I=1,NAI                                                   00542900
      IS=NA(I,IN2,IN1)                                                  00543000
      ISCT=NSCTL(IS)                                                    00543100
      IF (ISCT.EQ.0) GO TO 1610                                         00543200
      ITAO=ITA(I,IN2,IN1)                                               00543300
      IF (ITAO.LE.90) GO TO 1610                                        00543400
      IDLT(ISCT)=225*(IN1-1)+75*(IN2-1)+I                               00543500
      IF (ITAO.EQ.98) IDLT(ISCT)=-IDLT(ISCT)                            00543600
      INVH(IN2,IN1)=1                                                   00543700
      INVHF=1                                                           00543800
 1610 CONTINUE                                                          00543900
 1620 CONTINUE                                                          00544000
C                                                                       00544100
C     TIME LOOP                                                         00544200
 2000 DO 8950 IL=1,50000                                                00544300
      CALL TLPP                                                         00544400
C                                                                       00544500
C     PRINT TEMPERATURE-TIME DATA                                       00544600
 8000 TEST=TIMEC+0.01*DELTC                                             00544700
      TESTT=(TIMEC-TEND)+0.01*DELTC                                     00544701
      IF (ICLOCK.NE.0) CALL TIMEV(TT60)                                 00544800
      IF (TEST.LT.TIMEP) GO TO 8900                                     00544900
      NOPT=NOPT+1                                                       00545000
      ILO=IL-1                                                          00545100
      TIMEC=TIMEP                                                       00545200
      DELPO=TBLP(DELTP,TIMEC,0.0,IDUM)                                  00545300
      IF (DELPO.LE.0.0) DELPO=DELTC                                     00545400
      IF (DELTC.GT.DELPO) DELTC=DELPO                                   00545500
      TIMEP=TIMEP+DELPO                                                 00545600
      IF (TIMEP.GT.TEND) TIMEP=TEND                                     00545602
      TIMTT=DELPO/DELTC                                                 00545700
      TIMTT=TIMTT*1.0001                                                00545800
      IFIX=TIMTT                                                        00545900
      FLOT=IFIX                                                         00546000
      TIMTR=AMAX1(0.01,0.001*TIMTT)                                     00546100
      TIMTR=AMIN1(TIMTR,0.1)                                            00546200
      IF ((TIMTT-FLOT).GT.TIMTR) WRITE (6,830) TIMEC,DELTC,DELPO        00546300
      IF (ICLOCK.EQ.0) GO TO 8010                                       00546400
      CALL TIMEV(TIMEX)                                                 00546500
      TMEX=(TIMEX-TIME1)/60.0                                           00546600
 8010 IF (IPTT.LT.0.AND.IPTT.NE.-3) GO TO 8020                          00546700
      IF (IPNT.EQ.1) GO TO 8030                                         00546800
      IF (NCRTO(2).NE.0.OR.NCRTO(3).NE.0) GO TO 8020                    00546900
      IF (IPNT.GT.2) GO TO 8040                                         00547000
 8020 CALL WRITE (2,NSCTO,TIMEC,TN)                                     00547100
      IF (IPNT.GT.2) GO TO 8040                                         00547200
      IF (IPNT.EQ.2) GO TO 8050                                         00547300
      IF (ISIZE.GT.0.AND.IPNSZ.EQ.0) GO TO 8040                         00547400
 8030 WRITE (6,700) NCASE,TITLE                                         00547500
      WRITE (6,800) TIMEC,IRCT,DELTM,ILO,ITER,TMEX,                     00547600
     1(NSCT(I),TN(I),I=1,NSCTO)                                         00547700
      IF (IPNT.EQ.1) GO TO 8100                                         00547800
 8040 IF (NSPTO.EQ.0) GO TO 8050                                        00547900
      IF (IPTT.GT.0.AND.IPNT.NE.3) GO TO 8050                           00548000
      DO 8045 I=1,NSPTO                                                 00548100
      IS=NSPT(I)                                                        00548200
      ISCT=NSCTL(IS)                                                    00548300
 8045 TPD(I)=TN(ISCT)                                                   00548400
      CALL WRITE (3,NSPTO,TIMEC,TPD)                                    00548500
      WRITE (6,700) NCASE,TITLE                                         00548600
      WRITE (6,800) TIMEC,IRCT,DELTM,ILO,ITER,TMEX,                     00548700
     1(NSPT(I),TPD(I),I=1,NSPTO)                                        00548800
 8050 IF (NCRTOO.EQ.0) GO TO 8100                                       00548900
      IF (NCRTO(1).EQ.0) GO TO 8070                                     00549000
      TPD(1)=0.0                                                        00549100
      NCSEOO=NCSEO                                                      00549200
      IF (NCSEO.EQ.0) NCSEOO=1                                          00549300
      IF (NCSEO.EQ.0) GO TO 8065                                        00549400
      DO 8060 I=1,NCSEO                                                 00549500
      IS=NCSE(I)                                                        00549600
      ISCT=NSCTL(IS)                                                    00549700
      IF (ISCT.LT.1.OR.ISCT.GT.999) ISCT=1                              00549800
 8060 TPD(I)=TN(ISCT)                                                   00549900
 8065 CALL WRITE (4,NCSEOO,TIMEC,TPD)                                   00550000
 8070 IF (NHLDO.EQ.0) GO TO 8080                                        00550100
      DO 8075 I=1,NHLDO                                                 00550200
      IS=NHLD(I)                                                        00550300
      ISCT=NSCTL(IS)                                                    00550400
 8075 TPD(I)=QTOL(ISCT)                                                 00550500
      CALL WRITE (8,NHLDO,TIMEC,TPD)                                    00550600
 8080 IF (NHRTO.EQ.0) GO TO 8100                                        00550700
      DO 8085 I=1,NHRTO                                                 00550800
      IS=NHRT(I)                                                        00550900
      ISCT=NSCTL(IS)                                                    00551000
 8085 TPD(I)=QTOT(ISCT)                                                 00551100
      CALL WRITE (9,NHRTO,TIMEC,TPD)                                    00551200
 8100 IF (NPCMO.EQ.0) GO TO 8200                                        00551300
      IFLAG=0                                                           00551400
      DO 8130 I=1,3                                                     00551500
      NTPDO=0                                                           00551600
      DO 8110 J=1,NSCTO                                                 00551700
      IF (IPCT(J).NE.I) GO TO 8110                                      00551800
      IF (PCR(J).LE.0.0) GO TO 8110                                     00551900
      NTPDO=NTPDO+1                                                     00552000
      IDTA(NTPDO)=NSCT(J)                                               00552100
      TPD(NTPDO)=PCR(J)                                                 00552200
 8110 CONTINUE                                                          00552300
      IF (NTPDO.EQ.0) GO TO 8130                                        00552400
      IF (IFLAG.NE.0) GO TO 8120                                        00552500
      IFLAG=1                                                           00552600
      WRITE (6,810) TIMEC                                               00552700
 8120 WRITE (6,820) I,(IDTA(J),TPD(J),J=1,NTPDO)                        00552800
 8130 CONTINUE                                                          00552900
 8200 IF (ISIZE.EQ.0) GO TO 8900                                        00553000
      IF (STEMP(NSIZE).GT.TN(NDSZL)) GO TO 8900                         00553100
      STEMP(NSIZE)=TN(NDSZL)                                            00553200
      STIME(NSIZE)=TIMEC                                                00553300
C                                                                       00553400
C     END OF TIME LOOP                                                  00553500
 8900 IF (ICLOCK.EQ.0) GO TO 8910                                       00553600
      CALL TIMEV(TT61)                                                  00553700
      TT6=TT6+(TT61-TT60)                                               00553800
 8910 IF (TESTT.GT.0.0) GO TO 9000                                      00553900
 8950 CONTINUE                                                          00554000
C                                                                       00554100
C     EXIT                                                              00554200
 9000 IF (NCRTO(1).EQ.0) GO TO 9010                                     00554300
      IF (NCSSO.EQ.0) GO TO 9010                                        00554400
      NCPT(NCSSO)=NOPT                                                  00554500
 9010 RETURN                                                            00554600
      END                                                               00554700
*DECK WRITE                                                             00554701
      SUBROUTINE WRITE (NTAPE,NWDS,TIMEC,T)                             00554800
      DIMENSION T(NWDS)                                                 00554900
 1000 WRITE (NTAPE) TIMEC,T                                             00555000
 1090 RETURN                                                            00555100
      END                                                               00555200
*DECK TLPP                                                              00555201
C     SUBROUTINE TLPP OF PROGRAM XF0031                                 00555300
C     L.W. FESLER     41-383/530  X4263                                 00555400
C                                                                       00555500
C                *****      *****      *****      *****                 00555600
C                                                                       00555700
C     THIS SUBROUTINE COMPUTES THE TEMPERATURE OF EACH SECTION          00555800
C     FOR ALL TIME STEPS.                                               00555900
C                                                                       00556000
C                *****      *****      *****      *****                 00556100
C                                                                       00556200
      SUBROUTINE TLPP                                                   00556300
C                                                                       00556400
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00556500
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00556600
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00556700
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00556800
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00556900
     5              ICLOCK,IDOMT,INPP(33)                               00556901
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00557000
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00557100
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00557200
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00557300
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00557400
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00557500
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00557600
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00557700
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00557800
     2              DGP2(75),PGSF(75),BQGP(75),                         00557900
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00558000
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00558100
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00558200
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00558300
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00558400
     3              FP(75,3,2),BQA(75,3,2),                             00558500
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00558600
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00558700
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00558800
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00558900
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00559000
      COMMON /CMN7/ NRIO(3,2),NRI(25,3,2),ERI(25,3,2),DRI(25,3,2),      00559100
     1              ZRI(25,3,2),NAVT(2),BVT(40,40,2),NBVT(40,2),        00559200
     2              NVFO(2),NVFI(750,2),NVFJ(750,2),VFIJ(750,2)         00559300
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00559400
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00559500
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL,            00559600
     3              IMET(300),ICOET(8,300)                              00559700
C                                                                       00559800
      COMMON /CMNX/ QGPT(75),QTOL(300),PCR(300),IDTA(300),CAPO(300),    00559900
     1              TOSC,DELPO,DMTXT,IOSS,ITME,IRCT,DELTM,TMAVG,        00560000
     2              NQDTO,NQDT(300),QDT(8)                              00560001
      COMMON /CMNY/ TT1,TT2,TT3,TT4,TT5,TT6                             00560100
      COMMON /CMNI/ INVHF,INVH(3,2)                                     00560200
      DIMENSION QINV(450),QTOH(300)                                     00560300
      EQUIVALENCE (BQA(1,1,1),QINV(1)),(QTOH(1),TCR(1))                 00560400
      DATA CRVE / "CRVE" /                                              00560500
C                                                                       00560600
  200 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"CALCULATION INTERVAL TABLE ",   00560700
     1"VALUE"/1H 5X,"NEW DELTC=",F12.5)                                 00560800
  210 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"CALCULATION INTERVAL ",         00560900
     1"INCREASED - TEMPERATURE TEST"/1H 5X,"NEW DELTC=",F12.5)          00561000
  220 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"CALCULATION INTERVAL ",         00561100
     1"INCREASED - OSCILLATION TEST"/1H 5X,"NEW DELTC=",F12.5)          00561200
  400 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"CALCULATION INTERVAL BASED ",   00561300
     1"ON RCMIN VALUE *",F12.5/1H 5X,"DELTC=",F12.5)                    00561400
  700 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"CALCULATION INTERVAL ",         00561500
     1"DECREASED - TEMPERATURE TEST SECTION",I7/                        00561600
     21H 5X,"NEW DELTC=",F12.5)                                         00561700
  710 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"CALCULATION INTERVAL ",         00561800
     1"DECREASED - OSCILLATION TEST SECTION",I7/                        00561900
     21H 5X,"NEW DELTC=",F12.5)                                         00562000
  720 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"CALCULATION INTERVAL ",         00562100
     1"DECREASED MORE THAN TEN TIMES"/1H 5X,"END OF JOB - ABNORMAL ",   00562200
     2"END")                                                            00562300
  850 FORMAT(1H1////////////1H 40X,"********** WARNING **********"///   00562400
     11H 10X,"THE CALCULATION INTERVAL IS GREATER THAN ",               00562500
     2"THE STABILITY CALCULATION INTERVAL"/                             00562600
     31H 15X,"TIME=",F12.5," ,   DELTC=",F12.5," ,   RCTIME(",          00562700
     4I3,")=",F12.5///                                                  00562800
     51H 40X,"********** WARNING **********")                           00562900
  860 FORMAT(1H1////////////1H 40X,"********** WARNING **********"///   00563000
     11H 10X,"THE CALCULATION INTERVAL IS GREATER THAN FIVE TIMES ",    00563100
     2"THE STABILITY CALCULATION INTERVAL"/                             00563200
     31H 15X,"TIME=",F12.5," ,   DELTC=",F12.5," ,   RCTIME(",          00563300
     4I3,")=",F12.5///                                                  00563400
     51H 40X,"********** WARNING **********")                           00563500
  870 FORMAT(1H1)                                                       00563600
  880 FORMAT(1H05X,"NCASE",I4,5X,15A4/1H 5X,"TIMEP=",F12.5,10X,         00563700
     1"NETWORK PARAMETERS"/1H 5X,"NSCT",4X,"RCTIME  CAPACITANCE  ",     00563800
     2"CONDUCTANCES BTU/SEC-DEG F  (10000-X, 20000-Y, 30000-Z)")        00563900
  881 FORMAT(1H 5X,I4,F10.4,F13.6)                                      00564000
  882 FORMAT(1H+32X,4(2X,I5,"=",1PE9.3))                                00564100
  883 FORMAT(1H+32X,4(2X,I5,"=",1PE9.3)/1H 32X,4(2X,I5,"=",1PE9.3))     00564200
  884 FORMAT(1H05X,"NCASE",I4,5X,15A4/1H 5X,"TIMEP=",F12.5,10X,         00564201
     1"NETWORK PARAMETERS"/1H 5X,"NSCT",4X,"RCTIME  CAPACITANCE  ",     00564202
     2"CONDUCTANCES BTU/HRS-DEG F  (10000-X, 20000-Y, 30000-Z)")        00564203
  885 FORMAT(1H05X,"NCASE",I4,5X,15A4/1H 5X,"TIMEP=",F12.5,10X,         00564204
     1"QDOT BETWEEN NODES"/1H 5X,"NSCT    QDOT BTU/SEC  (10000-X, ",    00564205
     2"20000-Y, 30000-Z)")                                              00564206
  886 FORMAT(1H05X,"NCASE",I4,5X,15A4/1H 5X,"TIMEP=",F12.5,10X,         00564207
     1"QDOT BETWEEN NODES"/1H 5X,"NSCT    QDOT BTU/HRS  (10000-X, ",    00564208
     2"20000-Y, 30000-Z)")                                              00564209
  887 FORMAT(1H 5X,I4)                                                  00564210
  888 FORMAT(1H+11X,5(2X,I5,"=",1PE10.3))                               00564211
  889 FORMAT(1H+11X,5(2X,I5,"=",1PE10.3)/1H 11X,3(2X,I5,"=",1PE10.3))   00564212
C                                                                       00564300
C     LOOP                                                              00564400
 2000 IWARN=0                                                           00564500
      IF (IL.EQ.1) IWARN=1                                              00564600
      INWRK=0                                                           00564700
      IRISE=0                                                           00564800
      IDUM=0                                                            00564900
      IF (IL.EQ.1) DELTO=0.0                                            00564901
      IF (RCMIN.LE.-1.0) INWRK=1                                        00565000
      IF (IL.GT.1) GO TO 2100                                           00565100
      DMTX2=DMTX/2.0                                                    00565200
      IF (DMTX2.LE.0.0) DMTX2=1000.0                                    00565300
      IF (INWRK.GT.0) INWRK=2                                           00565400
      ICTR=1                                                            00565500
      ICTRT=99999                                                       00565600
      IF (RCMIN.LE.-1.0) ICTRT=ABS(RCMIN)                               00565700
      ICALC=0                                                           00565800
      DO 2020 I=1,NMTLO                                                 00565900
 2010 IF (BCDM(1,I).NE.CRVE) GO TO 2020                                 00566000
      ICALC=-2                                                          00566100
      GO TO 2100                                                        00566200
 2020 CONTINUE                                                          00566300
 2100 IF (ITME.EQ.0) GO TO 2200                                         00566400
      DELTS=TBLP(DELT,TIMEC,0.0,ITME)                                   00566500
      IF (DELTS.EQ.DELTO) GO TO 2200                                    00566600
      DELTT=ABS(DELTS )                                                 00566700
      TIMTT=(TIMEP-TIMEC)/DELTT                                         00566800
      IFIX=TIMTT                                                        00566900
      FLOT=IFIX                                                         00567000
      TIMTR=AMAX1(0.01,0.01*TIMTT)                                      00567100
      TIMTR=AMIN1(TIMTR,0.5)                                            00567200
      IF ((TIMTT-FLOT).GT.TIMTR) GO TO 2200                             00567300
      DELTC=DELTT                                                       00567400
      DELTO=DELTS                                                       00567500
      IOSN=0                                                            00567600
      IOST=0                                                            00567700
      IOSS=0                                                            00567800
      WRITE (6,200) TIMEC,DELTC                                         00567900
      IWARN=1                                                           00568000
      IF (INWRK.GT.0) INWRK=2                                           00568100
 2200 IF (IOST.EQ.0) GO TO 2300                                         00568200
      DO 2210 I=1,NSCTO                                                 00568300
      IF (ABS(TN(I)-TL(I)).GT.DMTXT) GO TO 2300                         00568400
 2210 CONTINUE                                                          00568500
      DELTT=2.0*DELTC                                                   00568600
      TIMTT=(TIMEP-TIMEC)/DELTT                                         00568700
      IFIX=TIMTT                                                        00568800
      FLOT=IFIX                                                         00568900
      TIMTR=AMAX1(0.01,0.01*TIMTT)                                      00569000
      TIMTR=AMIN1(TIMTR,0.5)                                            00569100
      IF ((TIMTT-FLOT).GT.TIMTR) GO TO 2300                             00569200
      DELTC=DELTT                                                       00569300
      IOST=IOST-1                                                       00569400
      WRITE (6,210) TIMEC,DELTC                                         00569500
      GO TO 2400                                                        00569600
 2300 IF (IOSN.EQ.0) GO TO 2400                                         00569700
      IOSS=IOSS+1                                                       00569800
      IF (IOSS.LT.50) GO TO 2400                                        00569900
      DELTT=2.0*DELTC                                                   00570000
      TIMTT=(TIMEP-TIMEC)/DELTT                                         00570100
      IFIX=TIMTT                                                        00570200
      FLOT=IFIX                                                         00570300
      TIMTR=AMAX1(0.01,0.01*TIMTT)                                      00570400
      TIMTR=AMIN1(TIMTR,0.5)                                            00570500
      IF ((TIMTT-FLOT).GT.TIMTR) GO TO 2400                             00570600
      DELTC=DELTT                                                       00570700
      IOSN=IOSN-1                                                       00570800
      WRITE (6,220) TIMEC,DELTC                                         00570900
 2400 TIMEC=TIMEC+DELTC                                                 00571000
      TMAVG=TIMEC-DELTC/2.0                                             00571100
      DO 2410 I=1,NSCTO                                                 00571200
      TNL=ABS(TN(I)-TL(I))                                              00571300
      IF (TNL.GT.DMTX2) IRISE=1                                         00571400
      TL2(I)=TL1(I)                                                     00571500
      TL1(I)=TL(I)                                                      00571600
 2410 TL(I)=TN(I)                                                       00571700
      ISKIP=0                                                           00571800
      IF (IL.EQ.1) GO TO 3000                                           00571900
      IF (IRISE.EQ.1) GO TO 3000                                        00572000
      IF (IWARN.EQ.1) GO TO 3000                                        00572100
      IF (INWRK.EQ.2) GO TO 3000                                        00572200
      IF (TIMEC.LE.DELPO) GO TO 3000                                    00572300
      TEST=TIMEC+0.01*DELTC                                             00572400
      IF (TEST.GE.TIMEP) GO TO 3000                                     00572500
      DDD=1.0                                                           00572600
      ISTT=IOSN+IOST                                                    00572700
      IF (ISTT.GT.0) DDD=2.0**ISTT                                      00572800
      DELTIN=DELTC*DDD                                                  00572900
      IDD=DELPO/DELTIN                                                  00573000
      IF (IDD.GT.100) IDD=100                                           00573100
      ILLO=1                                                            00573200
      IF (ICALC.EQ.0) ILLO=IDD/5                                        00573300
      IF (ICALC.EQ.-2) ILLO=IDD/2                                       00573400
      IF (ILLO.LE.0) ILLO=1                                             00573500
 2420 IOTT=IOST+IOSN                                                    00573600
      ILL=ILLO+IOTT                                                     00573700
      IF ((IL/ILL)*ILL.EQ.IL) GO TO 3000                                00573800
      ISKIP=1                                                           00573900
      IF (IOTT.GT.0) ISKIP=2                                            00574000
C                                                                       00574100
C     CAPACITANCE                                                       00574200
 3000 IF (ICAPT.EQ.0) GO TO 4000                                        00574300
      IF (ISKIP.GT.0) GO TO 4000                                        00574400
      IF (ICLOCK.NE.0) CALL TIMEV(TT10)                                 00574500
      CALL CAPD                                                         00574600
      IF (ICLOCK.EQ.0) GO TO 4000                                       00574700
      CALL TIMEV(TT11)                                                  00574800
      TT1=TT1+(TT11-TT10)                                               00574900
C                                                                       00575000
C     CONDUCTANCE                                                       00575100
 4000 IF (ICOND.EQ.0) GO TO 4400                                        00575200
      IF (ISKIP.GT.0) GO TO 4400                                        00575300
      IF (ICLOCK.NE.0) CALL TIMEV(TT20)                                 00575400
      CALL COND                                                         00575500
      IF (ICLOCK.EQ.0) GO TO 4400                                       00575600
      CALL TIMEV(TT21)                                                  00575700
      TT2=TT2+(TT21-TT20)                                               00575800
 4400 IF (IL.EQ.1) GO TO 4403                                           00575900
      ISKIP=0                                                           00576000
      IF (IWARN.EQ.1) GO TO 4405                                        00576100
      IF ((TIMEC+0.01*DELTC).LT.TIMEP) GO TO 6000                       00576200
 4403 TIMEC=TIMEP                                                       00576300
 4405 IRCT=0                                                            00576400
      DELTM=TEND                                                        00576500
      DO 4420 I=1,NSCTO                                                 00576600
      JN=IOSC(9,I)                                                      00576700
      TERM=0.0                                                          00576800
      TCR(I)=9999.0                                                     00576900
      IF (JN.EQ.0) GO TO 4420                                           00577000
      DO 4410 J=1,JN                                                    00577100
      TERM=TERM+COET(J,I)                                               00577200
 4410 CONTINUE                                                          00577300
      IF (TERM.LT.1.0E-20) GO TO 4420                                   00577400
      TERM=CAP(I)/TERM                                                  00577500
      TCR(I)=TERM                                                       00577600
      IF (TERM.GT.DELTM) GO TO 4420                                     00577700
      IRCT=NSCT(I)                                                      00577800
      DELTM=TERM                                                        00577900
 4420 CONTINUE                                                          00578000
      IF (IL.GT.1) GO TO 4430                                           00578100
      IF (RCMIN.EQ.0.0) GO TO 4430                                      00578400
      IF (RCMIN.LE.-1.0) GO TO 4430                                     00578500
      IF (FTRN.NE.0.0) GO TO 4430                                       00578600
      DELPO=TBLP(DELTP,TIMEC,0.0,IDUM)                                  00578700
      DELMM=ABS(RCMIN)*DELTM                                            00578800
      IF (DELMM.GT.DELPO) DELMM=DELPO                                   00578900
      IFIX=(DELPO+0.9*DELMM)/DELMM                                      00579000
      FLOT=IFIX                                                         00579100
      DELTC=DELPO/FLOT                                                  00579200
      WRITE (6,400) TIMEC,DELTM,DELTC                                   00579300
      IWARN=1                                                           00579400
 4430 IF (IWARN.EQ.0) GO TO 4450                                        00579500
      IF (FTRN.EQ.0.0) GO TO 4440                                       00579600
      IF (FTRN.GT.1.0) GO TO 4440                                       00579700
      IF (DELTC.LE.5.0*DELTM) GO TO 4450                                00579800
      WRITE (6,860) TIMEC,DELTC,IRCT,DELTM                              00579900
      WRITE (6,870)                                                     00580000
      IF (INWRK.GT.0) INWRK=2                                           00580100
      GO TO 4450                                                        00580200
 4440 IF (DELTC.LE.DELTM) GO TO 4450                                    00580300
      WRITE (6,850) TIMEC,DELTC,IRCT,DELTM                              00580400
      WRITE (6,870)                                                     00580500
      IF (INWRK.GT.0) INWRK=2                                           00580600
 4450 IF (IL.EQ.1) GO TO 4455                                           00580700
      IF (INWRK.EQ.0) GO TO 4490                                        00580800
      IF (INWRK.EQ.2) GO TO 4455                                        00580900
      IF (ICTR.GE.ICTRT) GO TO 4455                                     00581000
      ICTR=ICTR+1                                                       00581100
      GO TO 4490                                                        00581200
 4455 ICTR=1                                                            00581300
      IF (INPO(34).NE.1) WRITE (6,880) NCASE,TITLE,TIMEC                00581400
      IF (INPO(34).EQ.1) WRITE (6,884) NCASE,TITLE,TIMEC                00581401
      DO 4460 I=1,NSCTO                                                 00581500
      JN=IOSC(9,I)                                                      00581600
      WRITE (6,881) NSCT(I),TCR(I),CAP(I)                               00581700
      IF (JN.LE.0) GO TO 4460                                           00581800
      IF (JN.LE.4) WRITE (6,882) (NOSC(J,I),COET(J,I),J=1,JN)           00581900
      IF (JN.GT.4) WRITE (6,883) (NOSC(J,I),COET(J,I),J=1,JN)           00582000
 4460 CONTINUE                                                          00582100
 4490 IF (NQDTO.LE.0) GO TO 4500                                        00582200
      IF (INPO(34).NE.1) WRITE (6,885) NCASE,TITLE,TIMEC                00582201
      IF (INPO(34).EQ.1) WRITE (6,886) NCASE,TITLE,TIMEC                00582202
      DO 4495 I=1,NQDTO                                                 00582203
      JS=NQDT(I)                                                        00582204
      ISCT=NSCTL(JS)                                                    00582205
      JN=IOSC(9,ISCT)                                                   00582206
      WRITE (6,887) JS                                                  00582207
      IF (JN.EQ.0) GO TO 4495                                           00582208
      DO 4492 J=1,JN                                                    00582209
      JSCT=IOSC(J,ISCT)                                                 00582210
      QDT(J)=COET(J,ISCT)*(TN(JSCT)-TN(ISCT))                           00582211
 4492 CONTINUE                                                          00582212
      IF (JN.LE.5) WRITE (6,888) (NOSC(J,ISCT),QDT(J),J=1,JN)           00582213
      IF (JN.GT.5) WRITE (6,889) (NOSC(J,ISCT),QDT(J),J=1,JN)           00582214
 4495 CONTINUE                                                          00582500
 4500 IF (IL.EQ.1) GO TO 9000                                           00582600
C                                                                       00582700
C     NET HEAT                                                          00582800
 6000 IF (ISKIP.EQ.2) GO TO 7000                                        00582900
      IF (ICLOCK.NE.0) CALL TIMEV(TT30)                                 00583000
      CALL NETQ                                                         00583100
 6095 IF (ICLOCK.EQ.0) GO TO 7000                                       00583200
      CALL TIMEV(TT31)                                                  00583300
      TT3=TT3+(TT31-TT30)                                               00583400
C                                                                       00583500
C     SOLVE SYSTEM                                                      00583600
 7000 IF (ICLOCK.NE.0) CALL TIMEV(TT40)                                 00583700
      IF (NKTO.EQ.0) GO TO 7020                                         00583800
      DO 7010 I=1,NKTO                                                  00583900
      IS=NKT(I)                                                         00584000
      ISCT=NSCTL(IS)                                                    00584100
      IFTP(ISCT)=1                                                      00584200
      TVLE=TNKT(I)                                                      00584300
      IF (TVLE.LT.-460.0) TVLE=TBLP(TNKT(I),TIMEC,0.0,IDUM)             00584400
      IF (TVLE.LT.-460.0) GO TO 7003                                    00584500
      IF (INKT(I).GT.0) GO TO 7005                                      00584600
      IF (TNKT(I).GE.-460.0) GO TO 7010                                 00584700
      IF (TNKT(I).GE.-460.0) TN(ISCT)=TNKT(I)                           00584800
      IF (TNKT(I).LT.-460.0) TN(ISCT)=TVLE                              00584900
      GO TO 7010                                                        00585000
 7003 IFTP(ISCT)=3                                                      00585100
      GO TO 7010                                                        00585200
 7005 JS=INKT(I)                                                        00585300
      JSCT=NSCTL(JS)                                                    00585400
      TN(ISCT)=TL(JSCT)                                                 00585500
 7010 CONTINUE                                                          00585600
 7020 IF (FTRN.EQ.0.0) GO TO 7030                                       00585700
      IF (INVHF.GT.0) GO TO 7030                                        00585800
      IF (FTRN.EQ.5.0) GO TO 7025                                       00585900
      IF (FTRN.GT.1.0) GO TO 7030                                       00586000
 7025 CONTINUE                                                          00586100
      CALL IMPT                                                         00586200
      GO TO 7100                                                        00586300
 7030 CALL EXPT                                                         00586400
      IF (INVHF.GT.0) GO TO 7100                                        00586401
      IF (ABS(FTRN-0.5).LT.0.001) GO TO 7020                            00586500
 7100 IF (ICLOCK.EQ.0) GO TO 7105                                       00586600
      CALL TIMEV(TT41)                                                  00586700
      TT4=TT4+(TT41-TT40)                                               00586800
      CALL TIMEV(TT50)                                                  00586900
 7105 IF (DMTX.EQ.0.0) GO TO 7500                                       00587000
      DO 7110 I=1,NSCTO                                                 00587100
      IS=NSCT(I)                                                        00587200
      IF (ABS(TN(I)-TL(I)).GT.DMTX) GO TO 7120                          00587300
 7110 CONTINUE                                                          00587400
      GO TO 7200                                                        00587500
 7120 IFLAG=1                                                           00587600
      IOST=IOST+1                                                       00587700
      GO TO 7300                                                        00587800
 7200 IF (IOSS.LT.0) GO TO 7500                                         00587900
      DO 7220 I=1,NSCTO                                                 00588000
      IS=NSCT(I)                                                        00588100
      DD1=TN(I)-TL(I)                                                   00588200
      IF (ABS(DD1).LT.TOSC) GO TO 7500                                  00588300
      DD2=TL(I)-TL1(I)                                                  00588400
      IF (ABS(DD2).LT.TOSC) GO TO 7500                                  00588500
      DD3=TL1(I)-TL2(I)                                                 00588600
      IF (ABS(DD3).LT.TOSC) GO TO 7500                                  00588700
      IF (DD1.LT.0.0) GO TO 7210                                        00588800
      IF (DD2.GE.0.0) GO TO 7220                                        00588900
      IF (DD3.GE.0.0) GO TO 7230                                        00589000
      GO TO 7220                                                        00589100
 7210 IF (DD2.LE.0.0) GO TO 7220                                        00589200
      IF (DD3.LE.0.0) GO TO 7230                                        00589300
 7220 CONTINUE                                                          00589400
      GO TO 7500                                                        00589500
 7230 IFLAG=2                                                           00589600
      IOSN=IOSN+1                                                       00589700
      IOSS=-1                                                           00589800
 7300 IOTT=IOST+IOSN                                                    00589900
      IF (IOTT.LT.11) GO TO 7310                                        00590000
      WRITE (6,720) TIMEC                                               00590100
      STOP                                                              00590200
 7310 DELTC=DELTC/2.0                                                   00590300
      TIMEC=TIMEC-DELTC                                                 00590400
      TMAVG=TIMEC-DELTC/2.0                                             00590500
      IF (IFLAG.EQ.1) WRITE (6,700) TIMEC,IS,DELTC                      00590600
      IF (IFLAG.EQ.2) WRITE (6,710) TIMEC,IS,DELTC                      00590700
      GO TO 3000                                                        00590800
 7500 IF (ICLOCK.EQ.0) GO TO 7505                                       00590900
      CALL TIMEV(TT51)                                                  00591000
      TT5=TT5+(TT51-TT50)                                               00591100
 7505 DO 7520 I=1,NSCTO                                                 00591200
      JN=IOSC(9,I)                                                      00591300
      IF (JN.EQ.0) GO TO 7515                                           00591400
      DO 7510 J=1,JN                                                    00591500
      JS=IOSC(J,I)                                                      00591600
 7510 QTOT(I)=QTOT(I)+COET(J,I)*(TN(JS)-TN(I))                          00591700
 7515 IF (IFTP(I).EQ.1) QTOT(I)=CAP(I)*(TN(I)-TL(I))/DELTC-QTOT(I)      00591800
      IDX=IABS(IDLT(I))                                                 00591900
      IF (IDX.GT.0) QTOT(I)=QTOH(I)/QINV(IDX)                           00592000
      QTOL(I)=QTOL(I)+DELTC*QTOT(I)                                     00592100
 7520 CONTINUE                                                          00592200
      IF (NPCMO.EQ.0) GO TO 9000                                        00592300
 7530 DO 7590 I=1,NSCTO                                                 00592400
      PCR(I)=0.0                                                        00592500
      IF (IPCT(I).EQ.0) GO TO 7590                                      00592600
      IF (IFTP(I).EQ.1) GO TO 7590                                      00592700
      IMTP=LONP(MTLN(I),NPCMO,NPCM)                                     00592800
      IMTL=LONP(MTLN(I),NMTLO,NMTL)                                     00592900
      RHOO=TBLP(RHO(IMTL),TL(I),0.0,IDUM)                               00593000
 7540 IDX=IPCT(I)                                                       00593100
      IF (IDX.LE.3) GO TO 7545                                          00593200
      IF (TN(I).GE.TPCM(3,IMTP)) GO TO 7580                             00593300
      GO TO 7550                                                        00593400
 7545 TPCO=TPCM(IDX,IMTP)                                               00593500
      IF (TPCO.EQ.0.0) TPCO=1.0E10                                      00593600
      PCTT=RHOO*(ABS(DX(I)*DY(I)*DZ(I))/1728.0)*QPCM(IDX,IMTP)          00593700
      IF (IFTP(I).GT.0) GO TO 7560                                      00593800
      PCQL(I)=0.0                                                       00593900
      IF (TN(I).GE.TPCO) GO TO 7560                                     00594000
      IF (IDX.EQ.1) GO TO 7590                                          00594100
 7550 IDXO=IDX-1                                                        00594200
      IF (TN(I).GT.TPCM(IDXO,IMTP)) GO TO 7590                          00594300
      IPCT(I)=IPCT(I)-1                                                 00594400
      GO TO 7540                                                        00594500
 7560 IFTP(I)=2                                                         00594600
      TN(I)=TPCO                                                        00594700
      PCQL(I)=PCQL(I)+QTOT(I)*DELTC                                     00594800
      IF (ABS(PCQL(I)).LT.1.0E-06) GO TO 7580                           00594900
 7570 TST=ABS(PCQL(I))+1.0E-10                                          00595000
      PCR(I)=1.0-TST/PCTT                                               00595100
      IF (TST.LT.PCTT) GO TO 7590                                       00595200
 7580 IFTP(I)=0                                                         00595300
      IF (QTOT(I).LT.0.0) GO TO 7590                                    00595400
      IF (IPCT(I).LT.4) IPCT(I)=IPCT(I)+1                               00595500
 7590 CONTINUE                                                          00595600
C                                                                       00595700
C     EXIT                                                              00595800
 9000 RETURN                                                            00595900
      END                                                               00596000
*DECK CAPD                                                              00596001
C     SUBROUTINE CAPD OF PROGRAM XF0031                                 00596100
C     L.W. FESLER     41-383/530  X4263                                 00596200
C                                                                       00596300
C                *****      *****      *****      *****                 00596400
C                                                                       00596500
C     THIS SUBROUTINE COMPUTES THE CAPACITANCE OF EACH SECTION.         00596600
C                                                                       00596700
C                *****      *****      *****      *****                 00596800
C                                                                       00596900
      SUBROUTINE CAPD                                                   00597000
C                                                                       00597100
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00597200
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00597300
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00597400
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00597500
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00597600
     5              ICLOCK,IDOMT,INPP(33)                               00597601
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00597700
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00597800
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00597900
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00598000
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00598100
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL,            00598200
     3              IMET(300),ICOET(8,300)                              00598300
      COMMON /CMNX/ QGPT(75),QTOL(300),PCR(300),IDTA(300),CAPO(300),    00598400
     1              TOSC,DELPO,DMTXT,IOSS,ITME,IRCT,DELTM,TMAVG,        00598500
     2              NQDTO,NQDT(300),QDT(8)                              00598501
C                                                                       00598600
 3000 DO 3010 I=1,NSCTO                                                 00598700
      IF (CAPO(I).LE.0.0) GO TO 3010                                    00598800
      IMTL=IMET(I)                                                      00598900
      RHOO=RHO(IMTL)                                                    00599000
      IF (RHOO.LT.0.0) RHOO=TBLP(RHOO,TL(I),0.0,ICAPT)                  00599100
      CPO=CP(IMTL)                                                      00599200
      IF (CPO.LT.0.0) CPO=TBLP(CPO,TL(I),0.0,ICAPT)                     00599300
      CAP(I)=CAPO(I)*RHOO*CPO                                           00599400
 3010 CONTINUE                                                          00599500
C                                                                       00599600
C     EXIT                                                              00599700
 9000 RETURN                                                            00599800
      END                                                               00599900
*DECK NETQ                                                              00599901
C     SUBROUTINE NETQ OF PROGRAM XF0031                                 00600000
C     L.W. FESLER     41-383/530  X4263                                 00600100
C                                                                       00600200
C                *****      *****      *****      *****                 00600300
C                                                                       00600400
C     THIS SUBROUTINE COMPUTES THE NET HEAT TO EACH SECTION.            00600500
C                                                                       00600600
C                *****      *****      *****      *****                 00600700
C                                                                       00600800
      SUBROUTINE NETQ                                                   00600900
C                                                                       00601000
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00601100
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00601200
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00601300
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00601400
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00601500
     5              ICLOCK,IDOMT,INPP(33)                               00601501
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00601600
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00601700
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00601800
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00601900
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00602000
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00602100
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00602200
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00602300
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00602400
     2              DGP2(75),PGSF(75),BQGP(75),                         00602500
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00602600
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00602700
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00602800
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00602900
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00603000
     3              FP(75,3,2),BQA(75,3,2),                             00603100
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00603200
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00603300
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00603400
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00603500
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00603600
      COMMON /CMN7/ NRIO(3,2),NRI(25,3,2),ERI(25,3,2),DRI(25,3,2),      00603700
     1              ZRI(25,3,2),NAVT(2),BVT(40,40,2),NBVT(40,2),        00603800
     2              NVFO(2),NVFI(750,2),NVFJ(750,2),VFIJ(750,2)         00603900
      DIMENSION IBVT(40,40,2)                                           00604000
      EQUIVALENCE (BVT(1,1,1),IBVT(1,1,1))                              00604100
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00604200
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00604300
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL,            00604400
     3              IMET(300),ICOET(8,300)                              00604500
C                                                                       00604600
      COMMON /CMNX/ QGPT(75),QTOL(300),PCR(300),IDTA(300),CAPO(300),    00604700
     1              TOSC,DELPO,DMTXT,IOSS,ITME,IRCT,DELTM,TMAVG,        00604800
     2              NQDTO,NQDT(300),QDT(8)                              00604801
C                                                                       00604900
 6000 DO 6001 I=1,NSCTO                                                 00605000
 6001 QTOT(I)=0.0                                                       00605100
      IF (NGAPO.EQ.0) GO TO 6020                                        00605200
      DO 6010 I=1,NGAPO                                                 00605300
      IS=NGPI(I)                                                        00605400
      ISCT=NSCTL(IS)                                                    00605500
      IF (ISCT.EQ.0) GO TO 6010                                         00605600
      JS=NGPJ(I)                                                        00605700
      JSCT=NSCTL(JS)                                                    00605800
      IF (JSCT.EQ.0) GO TO 6010                                         00605900
      EGPIO=TBLP(EGPI(I),TL(ISCT),0.0,IDUM)                             00606000
      IF (EGPIO.LE.0.0) GO TO 6010                                      00606100
      EGPJO=TBLP(EGPJ(I),TL(JSCT),0.0,IDUM)                             00606200
      IF (EGPJO.LE.0.0) GO TO 6010                                      00606300
      IF (GPAR(I).EQ.0.0) GO TO 6003                                    00606400
      QGPT(I)=BQGP(I)*(((1.0+VFGP(I))*EGPIO*EGPJO)/((1.0+VFGP(I))*      00606500
     1(EGPIO+EGPJO)-2.0*EGPIO*EGPJO*VFGP(I)))*                          00606600
     2((TL(JSCT)+459.688)**4-(TL(ISCT)+459.688)**4)                     00606700
      GO TO 6007                                                        00606800
 6003 ARR=1.0                                                           00606900
      IF (DGP1(I).GE.0.0) GO TO 6005                                    00607000
      IF (DGP2(I).LE.0.0) GO TO 6005                                    00607100
      ARR=-DGP1(I)/DGP2(I)                                              00607200
 6005 EE1=(1.0-EGPIO)/EGPIO                                             00607300
      EE2=(1.0-EGPJO)/EGPJO                                             00607400
      VFBAR=VFGP(I)                                                     00607500
      VF1=1.0-VFBAR                                                     00607600
      IF (VF1.LT.1.0E-06) GO TO 6006                                    00607700
      VF2=1.0-ARR*VFBAR                                                 00607800
      IF (VF2.LT.1.0E-06) GO TO 6006                                    00607900
      VFBAR=VFBAR+1.0/(1.0/VF1+ARR/VF2)                                 00608000
 6006 QGPT(I)=BQGP(I)*(1.0/(EE1+1.0/VFBAR+EE2*ARR))*                    00608100
     1((TL(JSCT)+459.688)**4-(TL(ISCT)+459.688)**4)                     00608200
 6007 QTOT(ISCT)=QTOT(ISCT)+QGPT(I)                                     00608300
      QTOT(JSCT)=QTOT(JSCT)-QGPT(I)                                     00608400
 6010 CONTINUE                                                          00608500
 6020 IF (NAOO.EQ.0) GO TO 6040                                         00608600
      FCON=0.0                                                          00608700
      DO 6030 IN1=1,2                                                   00608800
      DO 6030 IN2=1,3                                                   00608900
      NAI=NAO(IN2,IN1)                                                  00609000
      IF (NAI.EQ.0) GO TO 6030                                          00609100
      DO 6026 I=1,NAI                                                   00609200
      IS=NA(I,IN2,IN1)                                                  00609300
      ISCT=NSCTL(IS)                                                    00609400
      IF (ISCT.EQ.0) GO TO 6026                                         00609500
      ITAO=ITA(I,IN2,IN1)                                               00609600
      IF (ITAO.GT.90) GO TO 6026                                        00609700
      IF (ITAO.NE.10) GO TO 6021                                        00609800
      FCON=FCOM                                                         00609900
      GO TO 6023                                                        00610000
 6021 TDUM=TL(ISCT)                                                     00610100
      FAO=TBLP(FA(I,IN2,IN1),TMAVG,0.0,IDUM)                            00610200
      IF (HR(I,IN2,IN1).NE.0.0) TDUM=TR(I,IN2,IN1)                      00610300
      IF (ITAO.NE.1) QAO=TBLP(QA(I,IN2,IN1),TMAVG,TDUM,IDUM)            00610400
      IF (ITAO.EQ.1) QAO=TBLP(QA(I,IN2,IN1),TL(ISCT),0.0,IDUM)          00610500
      AAO=TBLP(AA(I,IN2,IN1),TMAVG,0.0,IDUM)                            00610600
      FFO=1.0                                                           00610700
      IF (HR(I,IN2,IN1).EQ.0.0) GO TO 6022                              00610800
      HRO=TBLP(HR(I,IN2,IN1),TMAVG,0.0,IDUM)                            00610900
      FRO=TBLP(FR(I,IN2,IN1),TMAVG,0.0,IDUM)                            00611000
      FPO=TBLP(FP(I,IN2,IN1),TMAVG,0.0,IDUM)                            00611100
      PRO=FPO*TBLP(PR(I,IN2,IN1),TMAVG,0.0,IDUM)                        00611200
      FFFO=FRO*HRO                                                      00611300
      FFO=(FFFO-HAIR(TL(ISCT),PRO))/(FFFO-HAIR(TDUM,PRO))               00611400
 6022 FCON=FAO*QAO*AAO*FFO                                              00611500
      IF (ITAO.NE.2) GO TO 6023                                         00611600
      FCOM=FCON                                                         00611700
 6023 QTOT(ISCT)=QTOT(ISCT)+FCON*BQA(I,IN2,IN1)                         00611800
 6026 CONTINUE                                                          00611900
 6030 CONTINUE                                                          00612000
 6040 IF (NRSOO.EQ.0) GO TO 6060                                        00612100
      DO 6050 IN=1,3                                                    00612200
      NRSI=NRSO(IN)                                                     00612300
      IF (NRSI.EQ.0) GO TO 6050                                         00612400
      DO 6045 I=1,NRSI                                                  00612500
      IS=NRS(I,IN)                                                      00612600
      ISCT=NSCTL(IS)                                                    00612700
      IF (ISCT.EQ.0) GO TO 6045                                         00612800
      FRSO=TBLP(FRS(I,IN),TMAVG,0.0,IDUM)                               00612900
      ERSO=TBLP(ERS(I,IN),TL(ISCT),0.0,IDUM)                            00613000
      TRSO=TRS(I,IN)                                                    00613100
      IF (TRSO.LT.-460.0) TRSO=TBLP(TRSO,TMAVG,0.0,IDUM)                00613200
      QTOT(ISCT)=QTOT(ISCT)+FRSO*ERSO*BQRS(I,IN)*                       00613300
     1((TRSO+459.688)**4-(TL(ISCT)+459.688)**4)                         00613400
 6045 CONTINUE                                                          00613500
 6050 CONTINUE                                                          00613600
 6060 IF (NRIOO.EQ.0) GO TO 6080                                        00613700
      DO 6070 IN=1,2                                                    00613800
      NAVTO=NAVT(IN)                                                    00613900
      IF (NAVTO.EQ.0) GO TO 6070                                        00614000
      DO 6066 I=1,NAVTO                                                 00614100
      MAVTO=IBVT(I,I,IN)                                                00614200
      IF (MAVTO.EQ.0) GO TO 6066                                        00614300
      ISCT=NBVT(I,IN)                                                   00614400
      TLOO=(TL(ISCT)+459.688)**4                                        00614500
      DO 6063 J=1,MAVTO                                                 00614600
      IS=I+J                                                            00614700
      JJ=IBVT(IS,I,IN)                                                  00614800
      JSCT=NBVT(JJ,IN)                                                  00614900
      BVTO=BVT(I,JJ,IN)                                                 00615000
      QRIO=BVTO*((TL(JSCT)+459.688)**4-TLOO)                            00615100
      QTOT(ISCT)=QTOT(ISCT)+QRIO                                        00615200
      QTOT(JSCT)=QTOT(JSCT)-QRIO                                        00615300
 6063 CONTINUE                                                          00615400
 6066 CONTINUE                                                          00615500
 6070 CONTINUE                                                          00615600
 6080 IF (NCOO.EQ.0) GO TO 9000                                         00615700
      FCON=0.0                                                          00615800
      DO 6090 IN=1,3                                                    00615900
      NCOI=NCO(IN)                                                      00616000
      IF (NCOI.EQ.0) GO TO 6090                                         00616100
      DO 6086 I=1,NCOI                                                  00616200
      IS=NC(I,IN)                                                       00616300
      ISCT=NSCTL(IS)                                                    00616400
      IF (ISCT.EQ.0) GO TO 6086                                         00616500
      TLO=TL(ISCT)                                                      00616600
      ITCO=ITC(I,IN)                                                    00616700
      IF (ITCO.NE.10) GO TO 6081                                        00616800
      FCON=FCOM                                                         00616900
      TCO=TCOM                                                          00617000
      GO TO 6085                                                        00617100
 6081 FCO=TBLP(FC(I,IN),TMAVG,0.0,IDUM)                                 00617200
      TCO=TC(I,IN)                                                      00617300
      IF (TCO.LT.-460.0) TCO=TBLP(TCO,TMAVG,0.0,IDUM)                   00617400
      TCOO=TCO-TLO                                                      00617500
      IF (NCI(I,IN).LE.0) GO TO 6083                                    00617600
      ICI=NCI(I,IN)                                                     00617700
      NICI=NSCTL(ICI)                                                   00617800
      IF (NICI.EQ.0) GO TO 6083                                         00617900
      ICJ=NCJ(I,IN)                                                     00618000
      NICJ=NSCTL(ICJ)                                                   00618100
      IF (NICJ.EQ.0) GO TO 6083                                         00618200
      TCOO=(TL(NICI)+TL(NICJ))/2.0                                      00618300
      TCO=TCOO                                                          00618400
 6083 IF (ITCO.LT.1) HCO=TBLP(HC(I,IN),TCOO,0.0,IDUM)                   00618500
      IF (ITCO.GE.1) HCO=TBLP(HC(I,IN),TMAVG,TLO,IDUM)                  00618600
      FCON=FCO*HCO                                                      00618700
      IF (ITCO.NE.2) GO TO 6085                                         00618800
      FCOM=FCON                                                         00618900
      TCOM=TCO                                                          00619000
 6085 QTOT(ISCT)=QTOT(ISCT)+FCON*BQC(I,IN)*(TCO-TLO)                    00619100
 6086 CONTINUE                                                          00619200
 6090 CONTINUE                                                          00619300
C                                                                       00619400
C     EXIT                                                              00619500
 9000 RETURN                                                            00619600
      END                                                               00619700
*DECK IMPT                                                              00619701
C     SUBROUTINE IMPT OF PROGRAM XF0031                                 00619800
C     L.W. FESLER     41-383/530  X4263                                 00619900
C                                                                       00620000
C                *****      *****      *****      *****                 00620100
C                                                                       00620200
C     THIS SUBROUTINE EMPLOYES AN IMPLICIT FINITE DIFFERENCING          00620300
C     TECHNIQUE TO INTEGRATE THE HEAT FLOW EQUATION.                    00620400
C                                                                       00620500
C       FTRN=0.5     CRANK-NICOLSON                                     00620600
C       FTRN=1.0     BACKWARD DIFFERENCING                              00620700
C                                                                       00620800
C                *****      *****      *****      *****                 00620900
C                                                                       00621000
      SUBROUTINE IMPT                                                   00621100
C                                                                       00621200
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00621300
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00621400
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00621500
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00621600
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00621700
     5              ICLOCK,IDOMT,INPP(33)                               00621701
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00621800
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00621900
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00622000
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00622100
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00622200
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00622300
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL             00622400
C                                                                       00622500
      DIMENSION CNST(300),TNO(300)                                      00622600
      EQUIVALENCE (CNST(1),SLPO(1)),(TNO(1),SLP(1))                     00622700
C                                                                       00622800
  200 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"SYSTEM DID NOT CONVERGE ",      00622900
     1"AFTER TEN ITERATIONS"/1H 5X,"INCREASE TOLERANCE TO",F12.3)       00623000
  210 FORMAT(1H05X,"TIME=",F13.5/1H 5X,"SYSTEM DID NOT CONVERGE ",      00623100
     1"TO 100*TOLR=",F12.3/1H 5X,"END OF JOB - ABNORMAL END")           00623200
C                                                                       00623300
C     SET UP SYSTEM                                                     00623400
 1000 FRNO=1.0-FTRN                                                     00623500
      IPASS=0                                                           00623700
      DO 1040 I=1,NSCTO                                                 00623800
      TNO(I)=TN(I)                                                      00623900
      IF (IFTP(I).EQ.1) GO TO 1040                                      00624000
      JN=IOSC(9,I)                                                      00624100
      CAPDLT=CAP(I)/DELTC                                               00624200
      DEN=CAPDLT                                                        00624300
      TERM=0.0                                                          00624400
      IF (JN.EQ.0) GO TO 1020                                           00624500
      DO 1010 J=1,JN                                                    00624600
      JS=IOSC(J,I)                                                      00624700
      DEN=DEN+FTRN*COET(J,I)                                            00624800
 1010 TERM=TERM+FRNO*COET(J,I)*(TL(JS)-TL(I))                           00624900
 1020 CNST(I)=(CAPDLT/DEN)*TL(I)+(QTOT(I)+TERM)/DEN                     00625000
      TPD(I)=DEN                                                        00625100
 1040 CONTINUE                                                          00625500
C                                                                       00625600
C     SOLVE SYSTEM                                                      00625700
 2000 ICONV=0                                                           00625800
      DO 2030 I=1,NSCTO                                                 00625900
      IF (IFTP(I).EQ.1) GO TO 2030                                      00626000
      JN=IOSC(9,I)                                                      00626100
      TERM=0.0                                                          00626200
      IF (JN.EQ.0) GO TO 2020                                           00626300
      DO 2010 J=1,JN                                                    00626400
      JS=IOSC(J,I)                                                      00626500
 2010 TERM=TERM+(FTRN*COET(J,I)/TPD(I))*TN(JS)                          00626600
 2020 TN(I)=TERM+CNST(I)                                                00626700
      IF (ABS(TN(I)-TNO(I)).GE.TOLR1) ICONV=1                           00626800
 2030 CONTINUE                                                          00626900
      ITER=ITER+1                                                       00627000
      IF (ICONV.EQ.0) GO TO 9000                                        00627100
      IPASS=IPASS+1                                                     00627200
      IF (IPASS.LT.10) GO TO 2045                                       00627300
      TOLR1=2.0*TOLR1                                                   00627400
      IF (TOLR1.LT.TOLRE) GO TO 2040                                    00627500
      WRITE (6,210) TIMEC,TOLRE                                         00627600
      STOP                                                              00627700
 2040 WRITE (6,200) TIMEC,TOLR1                                         00627800
      IPASS=0                                                           00627900
 2045 DO 2050 I=1,NSCTO                                                 00628000
 2050 TNO(I)=TN(I)                                                      00628100
      GO TO 2000                                                        00628200
C                                                                       00628300
C     EXIT                                                              00628400
 9000 RETURN                                                            00628500
      END                                                               00628600
*DECK EXPT                                                              00628601
C     SUBROUTINE EXPT OF PROGRAM XF0031                                 00628700
C     L.W. FESLER     41-383/530  X4263                                 00628800
C                                                                       00628900
C                *****      *****      *****      *****                 00629000
C                                                                       00629100
C     THIS SUBROUTINE EMPLOYES AN EXPLICIT FINITE DIFFERENCING          00629200
C     TECHNIQUE TO INTEGRATE THE HEAT FLOW EQUATION.                    00629300
C                                                                       00629400
C       FTRN=0.0     FORWARD DIFFERENCING                               00629500
C       FTRN=2.0     ALTERNATING DIRECTION - FIRST PASS FORWARD         00629600
C       FTRN=3.0     ALTERNATING DIRECTION - FIRST PASS REVERSE         00629700
C       FTRN=4.0     ALTERNATING DIRECTION - AVERAGE                    00629800
C       FTRN=5.0     ONE-DIMENSIONAL DIRECT SOLUTION CRANK-NICOLSON     00629900
C       FTRN=6.0     BASHFORD-ADAMS                                     00630000
C                                                                       00630100
C                *****      *****      *****      *****                 00630200
C                                                                       00630300
      SUBROUTINE EXPT                                                   00630400
C                                                                       00630500
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00630600
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00630700
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00630800
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00630900
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00631000
     5              ICLOCK,IDOMT,INPP(33)                               00631001
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00631100
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00631200
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00631300
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00631400
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00631500
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00631600
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00631700
     3              FP(75,3,2),BQA(75,3,2),                             00631800
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00631900
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00632000
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00632100
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00632200
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00632300
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00632400
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00632500
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL             00632600
      COMMON /CMNI/ INVHF,INVH(3,2)                                     00632700
C                                                                       00632800
      DIMENSION INDX(300),E(300),F(300)                                 00632900
      EQUIVALENCE (INDX(1),SLP(1)),(E(1),TPD(1)),(F(1),TCR(1))          00633000
      DIMENSION QTOH(300),DEQQ(300)                                     00633100
      EQUIVALENCE (DEQQ(1),TPD(1)),(QTOH(1),TCR(1))                     00633200
C                                                                       00633300
  600 FORMAT(1H15X,"SYSTEM IS NOT ONE-DIMENSIONAL, SET FTRN=0.5")       00633400
C                                                                       00633500
C     TEST OPTION                                                       00633600
 1000 IF (FTRN.EQ.0.0) GO TO 1100                                       00633700
      IF (INVHF.GT.0) GO TO 1100                                        00633800
      IF (FTRN.EQ.2.0) GO TO 3000                                       00633900
      IF (FTRN.EQ.3.0) GO TO 3000                                       00634000
      IF (FTRN.EQ.4.0) GO TO 4000                                       00634100
      IF (FTRN.EQ.5.0) GO TO 6000                                       00634200
      IF (FTRN.EQ.6.0) GO TO 5000                                       00634300
      GO TO 9000                                                        00634400
C                                                                       00634500
 1100 DO 1105 I=1,NSCTO                                                 00634600
      DEQQ(I)=0.0                                                       00634700
 1105 QTOH(I)=0.0                                                       00634800
      IF (INVHF.EQ.0) GO TO 2000                                        00634900
      DO 1190 IN1=1,2                                                   00635000
      DO 1190 IN2=1,3                                                   00635100
      IF (INVH(IN2,IN1).EQ.0) GO TO 1190                                00635200
      NAI=NAO(IN2,IN1)                                                  00635300
      IF (NAI.EQ.0) GO TO 1190                                          00635400
      DO 1130 I=1,NAI                                                   00635500
      IS=NA(I,IN2,IN1)                                                  00635600
      ISCT=NSCTL(IS)                                                    00635700
      IF (ISCT.EQ.0) GO TO 1130                                         00635800
      ITAO=ITA(I,IN2,IN1)                                               00635900
      IF (ITAO.NE.99) GO TO 1130                                        00636000
      DELQ=CAP(ISCT)*(TN(ISCT)-TL(ISCT))/DELTC                          00636100
      DELQ=DELQ-QTOT(ISCT)                                              00636101
      JN=IOSC(9,ISCT)                                                   00636200
      IF (JN.EQ.0) GO TO 1120                                           00636300
      DO 1110 J=1,JN                                                    00636400
      JS=IOSC(J,ISCT)                                                   00636500
      DELQ=DELQ-COET(J,ISCT)*(TL(JS)-TL(ISCT))                          00636600
 1110 CONTINUE                                                          00636700
 1120 IF (DELQ.GE.0.0) GO TO 1125                                       00636800
      IF (FR(I,IN2,IN1).GT.0.0) DELQ=0.0                                00636900
 1125 DEQQ(ISCT)=DELQ/BQA(I,IN2,IN1)                                    00637000
 1130 CONTINUE                                                          00637100
      DO 1150 I=1,NAI                                                   00637200
      IS=NA(I,IN2,IN1)                                                  00637300
      ISCT=NSCTL(IS)                                                    00637400
      IF (ISCT.EQ.0) GO TO 1150                                         00637500
      ITAO=ITA(I,IN2,IN1)                                               00637600
      IF (ITAO.LE.90) GO TO 1150                                        00637700
      DELQ=DEQQ(ISCT)                                                   00637800
      IF (ITAO.EQ.99) GO TO 1140                                        00637900
      I991=PR(I,IN2,IN1)                                                00638000
      IF (I991.LE.0) I991=IS                                            00638100
      I991=NSCTL(I991)                                                  00638200
      I992=FP(I,IN2,IN1)                                                00638300
      IF (I992.LE.0) I992=IS                                            00638400
      I992=NSCTL(I992)                                                  00638500
      RAT=TR(I,IN2,IN1)                                                 00638600
      DELQ=(1.0-RAT)*DEQQ(I991)+RAT*DEQQ(I992)                          00638700
 1140 IF (DELQ.GE.0.0) GO TO 1145                                       00638800
      IF (FR(I,IN2,IN1).GT.0.0) DELQ=0.0                                00638900
 1145 QTOH(ISCT)=BQA(I,IN2,IN1)*DELQ                                    00639000
 1150 CONTINUE                                                          00639100
 1190 CONTINUE                                                          00639200
C                                                                       00639300
C     FORWARD DIFFERENCING                                              00639400
 2000 DO 2030 I=1,NSCTO                                                 00639500
      IF (IFTP(I).EQ.1) GO TO 2030                                      00639600
      JN=IOSC(9,I)                                                      00639700
      TERM=0.0                                                          00639800
      IF (JN.EQ.0) GO TO 2020                                           00639900
      DO 2010 J=1,JN                                                    00640000
      JS=IOSC(J,I)                                                      00640100
      IF (JS.EQ.0) GO TO 2010                                           00640200
      TERM=TERM+COET(J,I)*(TL(JS)-TL(I))                                00640300
 2010 CONTINUE                                                          00640400
 2020 TN(I)=TL(I)+DELTC*(TERM+QTOT(I)+QTOH(I))/CAP(I)                   00640500
 2030 CONTINUE                                                          00640600
      ITER=ITER+1                                                       00640700
      GO TO 9000                                                        00640800
C                                                                       00640900
C     ALTERNATING DIRECTION                                             00641000
 3000 DO 3040 IN=1,NSCTO                                                00641100
      I=IN                                                              00641200
      IF (IADR.EQ.1) I=NSCTO+1-IN                                       00641300
      IF (IFTP(I).EQ.1) GO TO 3040                                      00641400
      JN=IOSC(9,I)                                                      00641500
      TERM=0.0                                                          00641600
      DEN=0.0                                                           00641700
      IF (JN.EQ.0) GO TO 3030                                           00641800
      DO 3020 J=1,JN                                                    00641900
      JS=IOSC(J,I)                                                      00642000
      IF (JS.EQ.0) GO TO 3020                                           00642100
      IF (IADR.EQ.0.AND.JS.LT.I) GO TO 3010                             00642200
      IF (IADR.EQ.1.AND.JS.GT.I) GO TO 3010                             00642300
      TERM=TERM+COET(J,I)*(TL(JS)-TL(I))                                00642400
      GO TO 3020                                                        00642500
 3010 TERM=TERM+COET(J,I)*TN(JS)                                        00642600
      DEN=DEN+COET(J,I)                                                 00642700
 3020 CONTINUE                                                          00642800
 3030 DEN=CAP(I)+DELTC*DEN                                              00642900
      TN(I)=(CAP(I)*TL(I)+DELTC*(TERM+QTOT(I)))/DEN                     00643000
 3040 CONTINUE                                                          00643100
      IADR=IADR+1                                                       00643200
      IF (IADR.GT.1) IADR=0                                             00643300
      ITER=ITER+1                                                       00643400
      GO TO 9000                                                        00643500
C                                                                       00643600
C     ALTERNATING DIRECTION - AVG                                       00643700
 4000 DO 4040 I=1,NSCTO                                                 00643800
      IF (IFTP(I).EQ.1) TPD(I)=TN(I)                                    00643900
      IF (IFTP(I).EQ.1) GO TO 4040                                      00644000
      JN=IOSC(9,I)                                                      00644100
      TERM=0.0                                                          00644200
      DEN=0.0                                                           00644300
      IF (JN.EQ.0) GO TO 4030                                           00644400
      DO 4020 J=1,JN                                                    00644500
      JS=IOSC(J,I)                                                      00644600
      IF (JS.LT.I) GO TO 4010                                           00644700
      TERM=TERM+COET(J,I)*(TL(JS)-TL(I))                                00644800
      GO TO 4020                                                        00644900
 4010 TERM=TERM+COET(J,I)*TPD(JS)                                       00645000
      DEN=DEN+COET(J,I)                                                 00645100
 4020 CONTINUE                                                          00645200
 4030 DEN=CAP(I)+DELTC*DEN                                              00645300
      TPD(I)=(CAP(I)*TL(I)+DELTC*(TERM+QTOT(I)))/DEN                    00645400
 4040 CONTINUE                                                          00645500
 4100 DO 4140 IN=1,NSCTO                                                00645600
      I=NSCTO+1-IN                                                      00645700
      IF (IFTP(I).EQ.1) TCR(I)=TN(I)                                    00645800
      IF (IFTP(I).EQ.1) GO TO 4140                                      00645900
      JN=IOSC(9,I)                                                      00646000
      TERM=0.0                                                          00646100
      DEN=0.0                                                           00646200
      IF (JN.EQ.0) GO TO 4130                                           00646300
      DO 4120 J=1,JN                                                    00646400
      JS=IOSC(J,I)                                                      00646500
      IF (JS.GT.I) GO TO 4110                                           00646600
      TERM=TERM+COET(J,I)*(TL(JS)-TL(I))                                00646700
      GO TO 4120                                                        00646800
 4110 TERM=TERM+COET(J,I)*TCR(JS)                                       00646900
      DEN=DEN+COET(J,I)                                                 00647000
 4120 CONTINUE                                                          00647100
 4130 DEN=CAP(I)+DELTC*DEN                                              00647200
      TCR(I)=(CAP(I)*TL(I)+DELTC*(TERM+QTOT(I)))/DEN                    00647300
 4140 CONTINUE                                                          00647400
 4200 DO 4210 I=1,NSCTO                                                 00647500
      IF (IFTP(I).EQ.1) GO TO 4210                                      00647600
      TN(I)=(TPD(I)+TCR(I))/2.0                                         00647700
 4210 CONTINUE                                                          00647800
      ITER=ITER+2                                                       00647900
      GO TO 9000                                                        00648000
C                                                                       00648100
C     BASHFORD-ADAMS                                                    00648200
 5000 DO 5030 I=1,NSCTO                                                 00648300
      IF (IFTP(I).EQ.1) TPD(I)=TN(I)                                    00648400
      IF (IFTP(I).EQ.1) GO TO 5030                                      00648500
      JN=IOSC(9,I)                                                      00648600
      TERM=0.0                                                          00648700
      IF (JN.EQ.0) GO TO 5020                                           00648800
      DO 5010 J=1,JN                                                    00648900
      JS=IOSC(J,I)                                                      00649000
      TERM=TERM+COET(J,I)*(TL(JS)-TL(I))                                00649100
 5010 CONTINUE                                                          00649200
 5020 SLP1=(TERM+QTOT(I))/CAP(I)                                        00649300
      IF (IL.EQ.2) SLP(I)=SLP1                                          00649400
      IF (IL.GT.2) SLP(I)=(3.0*SLP1-SLPO(I))/2.0                        00649500
      SLP(I)=SLP1                                                       00649600
      TPD(I)=TL(I)+SLP(I)*DELTC                                         00649700
 5030 CONTINUE                                                          00649800
 5100 DO 5130 I=1,NSCTO                                                 00649900
      IF (IFTP(I).EQ.1) GO TO 5130                                      00650000
      JN=IOSC(9,I)                                                      00650100
      TERM=0.0                                                          00650200
      IF (JN.EQ.0) GO TO 5120                                           00650300
      DO 5110 J=1,JN                                                    00650400
      JS=IOSC(J,I)                                                      00650500
      TERM=TERM+COET(J,I)*(TPD(JS)-TPD(I))                              00650600
 5110 CONTINUE                                                          00650700
 5120 SLP2=(TERM+QTOT(I))/CAP(I)                                        00650800
      SLP(I)=(SLP(I)+SLP2)/2.0                                          00650900
      TCR(I)=TL(I)+SLP(I)*DELTC                                         00651000
      IF (ABS(TCR(I)-TPD(I)).LE.TOLR) GO TO 5130                        00651100
 5130 CONTINUE                                                          00651200
      DO 5140 I=1,NSCTO                                                 00651300
      IF (IFTP(I).EQ.1) GO TO 5140                                      00651400
      TN(I)=TCR(I)                                                      00651500
      SLPO(I)=SLP(I)                                                    00651600
 5140 CONTINUE                                                          00651700
      ITER=ITER+2                                                       00651800
      GO TO 9000                                                        00651900
C                                                                       00652000
C     ONE-DIMENSIONAL DIRECT SOLUTION CRANK-NICOLSON                    00652100
 6000 IF (IL.GT.2) GO TO 6100                                           00652200
      INDX(1)=0                                                         00652300
      INDX(NSCTO)=0                                                     00652400
      DO 6010 I=1,NSCTO                                                 00652500
      IS=NSCT(I)                                                        00652600
      IF (IOSC(9,I).GT.1) GO TO 6010                                    00652700
      IF (INDX(NSCTO).NE.0) GO TO 6020                                  00652800
      IF (INDX(1).NE.0) INDX(NSCTO)=IS                                  00652900
      IF (INDX(1).EQ.0) INDX(1)=IS                                      00653000
 6010 CONTINUE                                                          00653100
      IF (INDX(1).GT.0.AND.INDX(NSCTO).GT.0) GO TO 6030                 00653200
 6020 WRITE (6,600)                                                     00653300
      FTRN=0.5                                                          00653400
      GO TO 9000                                                        00653500
 6030 NSCT1=NSCTO-1                                                     00653600
      DO 6050 I=2,NSCT1                                                 00653700
      IS=INDX(I-1)                                                      00653800
      ISCT=NSCTL(IS)                                                    00653900
      JSCT=IOSC(1,ISCT)                                                 00654000
      ITST=0                                                            00654100
      IF (I.GT.2) ITST=INDX(I-2)                                        00654200
      IF (NSCT(JSCT).EQ.ITST) JSCT=IOSC(2,ISCT)                         00654300
      INDX(I)=NSCT(JSCT)                                                00654400
 6050 CONTINUE                                                          00654500
 6100 DO 6150 I=1,NSCTO                                                 00654600
      IS=INDX(I)                                                        00654700
      ISCT=NSCTL(IS)                                                    00654800
      JN=IOSC(9,ISCT)                                                   00654900
      A=0.0                                                             00655000
      B=CAP(ISCT)/DELTC                                                 00655100
      C=0.0                                                             00655200
      D=CAP(ISCT)*TL(ISCT)/DELTC+QTOT(ISCT)                             00655300
      IF (JN.EQ.0) GO TO 6140                                           00655400
      DO 6130 J=1,JN                                                    00655500
      JS=IOSC(J,ISCT)                                                   00655600
      COETO=0.5*COET(J,ISCT)                                            00655700
      IF (JS.GT.ISCT) GO TO 6120                                        00655800
 6110 A=A-COETO                                                         00655900
      B=B+COETO                                                         00656000
      D=D+COETO*(TL(JS)-TL(ISCT))                                       00656100
      GO TO 6130                                                        00656200
 6120 B=B+COETO                                                         00656300
      C=C-COETO                                                         00656400
      D=D+COETO*(TL(JS)-TL(ISCT))                                       00656500
 6130 CONTINUE                                                          00656600
 6140 EO=0.0                                                            00656700
      FO=0.0                                                            00656800
      IF (I.EQ.1) GO TO 6145                                            00656900
      JS=INDX(I-1)                                                      00657000
      JSCT=NSCTL(JS)                                                    00657100
      EO=E(JSCT)                                                        00657200
      FO=F(JSCT)                                                        00657300
 6145 DON=B-A*EO                                                        00657400
      E(ISCT)=C/DON                                                     00657500
      F(ISCT)=(D-A*FO)/DON                                              00657600
      IF (IFTP(ISCT).NE.1) GO TO 6150                                   00657700
      E(ISCT)=0.0                                                       00657800
      F(ISCT)=TN(ISCT)                                                  00657900
 6150 CONTINUE                                                          00658000
 6200 IF (IFTP(ISCT).NE.1) TN(ISCT)=F(NSCTO)                            00658100
      DO 6210 I=2,NSCTO                                                 00658200
      J=NSCTO+1-I                                                       00658300
      IS=INDX(J)                                                        00658400
      ISCT=NSCTL(IS)                                                    00658500
      IF (IFTP(ISCT).EQ.1) GO TO 6210                                   00658600
      JS=INDX(J+1)                                                      00658700
      JSCT=NSCTL(JS)                                                    00658800
      TN(ISCT)=F(ISCT)-E(ISCT)*TN(JSCT)                                 00658900
 6210 CONTINUE                                                          00659000
      ITER=ITER+1                                                       00659100
C                                                                       00659200
C     EXIT                                                              00659300
 9000 RETURN                                                            00659400
      END                                                               00659500
*DECK SDST                                                              00659501
C     SUBROUTINE SDST OF PROGRAM XF0031                                 00659600
C     L.W. FESLER     41-383/530  X4263                                 00659700
C                                                                       00659800
C                *****      *****      *****      *****                 00659900
C                                                                       00660000
C     THIS SUBROUTINE COMPUTES THE STEADY STATE SOLUTION.               00660100
C                                                                       00660200
C                *****      *****      *****      *****                 00660300
C                                                                       00660400
      SUBROUTINE SDST                                                   00660500
C                                                                       00660600
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00660700
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00660800
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00660900
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00661000
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00661100
     5              ICLOCK,IDOMT,INPP(33)                               00661101
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00661200
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00661300
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00661400
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300)        00661500
      COMMON /CMN4/ NMTLO,NMTL(20),RHO(20),CP(20),TKX(20),              00661600
     1              TKY(20),TKZ(20),PMSF(20),BCDM(8,20),                00661700
     2              NPCMO,NPCM(20),TPCM(3,20),QPCM(3,20),BCDP(8,20)     00661800
      COMMON /CMN5/ NGAPO,NGPI(75),NGPJ(75),GPL(75),GPAR(75),TKG(75),   00661900
     1              TKC(75),EGPI(75),EGPJ(75),VFGP(75),DGP1(75),        00662000
     2              DGP2(75),PGSF(75),BQGP(75),                         00662100
     3              NOFSO,NOFI(50),NOFJ(50),OFL1(50),OFL2(50),          00662200
     4              NCCTO,NCCI(50),NCCJ(50),CCT(50)                     00662300
      COMMON /CMN6/ NAO(3,2),NA(75,3,2),FA(75,3,2),QA(75,3,2),          00662400
     1              AA(75,3,2),DA(75,3,2),ZA(75,3,2),ITA(75,3,2),       00662500
     2              HR(75,3,2),FR(75,3,2),TR(75,3,2),PR(75,3,2),        00662600
     3              FP(75,3,2),BQA(75,3,2),                             00662700
     4              NRSO(3),NRS(75,3),FRS(75,3),ERS(75,3),TRS(75,3),    00662800
     5              DRS(75,3),ZRS(75,3),BQRS(75,3),                     00662900
     6              NCO(3),NC(50,3),FC(50,3),HC(50,3),TC(50,3),         00663000
     7              DC(50,3),ZC(50,3),ITC(50,3),NCI(50,3),NCJ(50,3),    00663100
     8              BQC(50,3),NKTO,NKT(50),TNKT(50),INKT(50)            00663200
      COMMON /CMN7/ NRIO(3,2),NRI(25,3,2),ERI(25,3,2),DRI(25,3,2),      00663300
     1              ZRI(25,3,2),NAVT(2),BVT(40,40,2),NBVT(40,2),        00663400
     2              NVFO(2),NVFI(750,2),NVFJ(750,2),VFIJ(750,2)         00663500
      DIMENSION IBVT(40,40,2)                                           00663501
      EQUIVALENCE (BVT(1,1,1),IBVT(1,1,1))                              00663502
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00663600
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00663700
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL,            00663800
     3              IMET(300),ICOET(8,300)                              00663900
C                                                                       00664000
      DIMENSION QGPT(75),QIN(300),QOUT(300),QRAT(300)                   00664100
      REAL   TN8(300),TL8(300),DEL8                                     00664200
C                                                                       00664300
  600 FORMAT(1H15X,"STEADY STATE SOLUTION",10X,"(TIME=",F8.2,           00664400
     1", ITERATIONS=",I6,")"/1H 5X,"NCASE",I4///1H 5X,"SECTION",6X,     00664500
     2"TEMPERATURE",15X,"QIN",13X,"QOUT",13X,"QRAT",12X,"DEL T"/        00664600
     31H 22X,"(DEG F)",9X,"(BTU/SEC)",8X,"(BTU/SEC)",27X,"(DEG F)"/     00664700
     4(1H 5X,I7,2X,F15.4,E18.6,E17.6,2F17.8))                           00664800
  870 FORMAT(1H1)                                                       00664900
  880 FORMAT(1H05X,"NCASE",I4,5X,15A4/1H 5X,"TIMEP=",F12.5,10X,         00665000
     1"NETWORK PARAMETERS"/1H 5X,"NSCT",4X,"RCTIME  CAPACITANCE  ",     00665100
     2"CONDUCTANCES BTU/SEC-DEG F  (10000-X, 20000-Y, 30000-Z)")        00665200
  881 FORMAT(1H 5X,I4,F10.4,F13.6)                                      00665300
  882 FORMAT(1H+32X,4(2X,I5,"=",1PE9.3))                                00665400
  883 FORMAT(1H+32X,4(2X,I5,"=",1PE9.3)/1H 32X,4(2X,I5,"=",1PE9.3))     00665500
C                                                                       00665600
C     INITIALIZE                                                        00665700
 1000 ITER=0                                                            00665800
      NSPTO=0                                                           00665900
      IQOT=1                                                            00666000
      TOLL=TOLR                                                         00666100
      TOLRM=2.0*TOLL                                                    00666200
      FTTT=FTRN                                                         00666300
      IF (FTTT.GT.0.5) FTTT=0.5                                         00666400
      TIMEC=TEND                                                        00666500
      DO 1010 I=1,NSCTO                                                 00666600
      TN(I)=TO(I)                                                       00666700
      TL(I)=TO(I)                                                       00666800
      TL8(I)=TL(I)                                                      00666900
      TCR(I)=0.0                                                        00667000
      QIN(I)=0.0                                                        00667100
      QOUT(I)=0.0                                                       00667200
      QRAT(I)=0.0                                                       00667300
      IFTP(I)=0                                                         00667400
      IPCT(I)=0                                                         00667500
      IMET(I)=LONP(MTLN(I),NMTLO,NMTL)                                  00667600
      IF (IPRNT(I).NE.1) GO TO 1010                                     00667700
      NSPTO=NSPTO+1                                                     00667800
      NSPT(NSPTO)=NSCT(I)                                               00667900
 1010 CONTINUE                                                          00668000
      DMAX=1000.0                                                       00668100
      IF (DMTX.NE.60.0) DMAX=DMTX                                       00668200
      IMAX=DMAX                                                         00668300
      IMXX=IMAX/4                                                       00668400
      IPNT=IMAX                                                         00668500
      IF (DELTP.LE.0.0.OR.TEND.LE.0.0) GO TO 1100                       00668600
      DELPO=TBLP(DELTP,TIMEC,0.0,IDUM)                                  00668700
      IPNT=DELPO*DMAX/ABS(TEND)+0.1                                     00668800
 1100 IF (NKTO.EQ.0) GO TO 1120                                         00668900
      DO 1110 I=1,NKTO                                                  00669000
      IS=NKT(I)                                                         00669100
      ISCT=NSCTL(IS)                                                    00669200
      IF (INKT(I).GT.0) GO TO 1105                                      00669300
      IF (TNKT(I).EQ.0.0) GO TO 1110                                    00669400
      IF (TNKT(I).GE.-460.0) TN(ISCT)=TNKT(I)                           00669500
      IF (TNKT(I).LT.-460.0) TN(ISCT)=TBLP(TNKT(I),TIMEC,0.0,IDUM)      00669600
      GO TO 1110                                                        00669700
 1105 JS=INKT(I)                                                        00669800
      JSCT=NSCTL(JS)                                                    00669900
      TN(ISCT)=TL(JSCT)                                                 00670000
 1110 IFTP(ISCT)=1                                                      00670100
 1120 ICOND=-1                                                          00670200
      CALL COND                                                         00670300
C                                                                       00670400
C     CONDUCTANCE                                                       00670500
 2000 IF (ICOND.EQ.0) GO TO 2500                                        00670600
      CALL COND                                                         00670700
C                                                                       00670800
 2500 IF (NKTO.EQ.0) GO TO 3000                                         00670900
      DO 2510 I=1,NKTO                                                  00671000
      IF (INKT(I).LE.0) GO TO 2510                                      00671100
      IS=NKT(I)                                                         00671200
      ISCT=NSCTL(IS)                                                    00671300
      JS=INKT(I)                                                        00671400
      JSCT=NSCTL(JS)                                                    00671500
      TN(ISCT)=TL(JSCT)                                                 00671600
 2510 CONTINUE                                                          00671700
C                                                                       00671800
C     GAP                                                               00671900
 3000 IF (NGAPO.EQ.0) GO TO 4000                                        00672000
      DO 3030 I=1,NGAPO                                                 00672100
      QGPT(I)=0.0                                                       00672200
      IS=NGPI(I)                                                        00672300
      ISCT=NSCTL(IS)                                                    00672400
      TLI=TL(ISCT)+459.688                                              00672500
      JS=NGPJ(I)                                                        00672600
      JSCT=NSCTL(JS)                                                    00672700
      TLJ=TL(JSCT)+459.688                                              00672800
      EGPIO=TBLP(EGPI(I),TL(ISCT),0.0,IDUM)                             00672900
      EGPJO=TBLP(EGPJ(I),TL(JSCT),0.0,IDUM)                             00673000
      IF (GPAR(I).EQ.0.0) GO TO 3010                                    00673100
      QGPT(I)=BQGP(I)*(((1.0+VFGP(I))*EGPIO*EGPJO)/((1.0+VFGP(I))*      00673200
     1(EGPIO+EGPJO)-2.0*EGPIO*EGPJO*VFGP(I)))*                          00673300
     2(TLJ**3+TLI*TLJ**2+TLJ*TLI**2+TLI**3)                             00673400
      GO TO 3030                                                        00673500
 3010 ARR=1.0                                                           00673600
      IF (DGP1(I).GE.0.0) GO TO 3020                                    00673700
      IF (DGP2(I).LE.0.0) GO TO 3020                                    00673800
      ARR=-DGP1(I)/DGP2(I)                                              00673900
 3020 EE1=(1.0-EGPIO)/EGPIO                                             00674000
      EE2=(1.0-EGPJO)/EGPJO                                             00674100
      VFBAR=VFGP(I)                                                     00674200
      VF1=1.0-VFBAR                                                     00674300
      IF (VF1.LT.1.0E-06) GO TO 3025                                    00674400
      VF2=1.0-ARR*VFBAR                                                 00674500
      IF (VF2.LT.1.0E-06) GO TO 3025                                    00674600
      VFBAR=VFBAR+1.0/(1.0/VF1+ARR/VF2)                                 00674700
 3025 QGPT(I)=BQGP(I)*(1.0/(EE1+1.0/VFBAR+EE2*ARR))*                    00674800
     1(TLJ**3+TLI*TLJ**2+TLJ*TLI**2+TLI**3)                             00674900
 3030 CONTINUE                                                          00675000
C                                                                       00675100
C     NET HEAT                                                          00675200
 4000 IF (IQOT.EQ.0) GO TO 5000                                         00675300
      IQOT=0                                                            00675400
      DO 4090 I=1,NSCTO                                                 00675500
      QTOTO=0.0                                                         00675600
      IS=NSCT(I)                                                        00675700
      TLO=TL(I)                                                         00675800
 4010 IF (NAOO.EQ.0) GO TO 4070                                         00675900
      DO 4020 IN1=1,2                                                   00676000
      DO 4020 IN2=1,3                                                   00676100
      NAI=NAO(IN2,IN1)                                                  00676200
      IF (NAI.EQ.0) GO TO 4020                                          00676300
      IDX=LONP(IS,NAI,NA(1,IN2,IN1))                                    00676400
      IF (IDX.EQ.0) GO TO 4020                                          00676500
      FAO=TBLP(FA(IDX,IN2,IN1),TIMEC,0.0,IDUM)                          00676600
      TDUM=TLO                                                          00676700
      IF (HR(IDX,IN2,IN1).NE.0.0) TDUM=TR(IDX,IN2,IN1)                  00676800
      ITAO=ITA(IDX,IN2,IN1)                                             00676900
      IF (ITAO.NE.1) QAO=TBLP(QA(IDX,IN2,IN1),TIMEC,TDUM,IQOT)          00677000
      IF (ITAO.EQ.1) QAO=TBLP(QA(IDX,IN2,IN1),TLO,0.0,IQOT)             00677100
      AAO=TBLP(AA(IDX,IN2,IN1),TIMEC,0.0,IDUM)                          00677200
      FFO=1                                                             00677300
      IF (HR(IDX,IN2,IN1).EQ.0.0) GO TO 4015                            00677400
      HRO=TBLP(HR(IDX,IN2,IN1),TIMEC,0.0,IDUM)                          00677500
      FRO=TBLP(FR(IDX,IN2,IN1),TIMEC,0.0,IDUM)                          00677600
      FPO=TBLP(FP(IDX,IN2,IN1),TIMEC,0.0,IDUM)                          00677700
      PRO=FPO*TBLP(PR(IDX,IN2,IN1),TIMEC,0.0,IDUM)                      00677800
      FFFO=FRO*HRO                                                      00677900
      FFO=(FFFO-HAIR(TLO,PRO))/(FFFO-HAIR(TDUM,PRO))                    00678000
 4015 QTOTO=QTOTO+FAO*QAO*AAO*FFO*BQA(IDX,IN2,IN1)                      00678100
 4020 CONTINUE                                                          00678200
 4070 QTOT(I)=QTOTO                                                     00678300
 4090 CONTINUE                                                          00678400
C                                                                       00678500
C     SOLVE SYSTEM                                                      00678600
 5000 ICONV=0                                                           00678700
      IEXP=1+ITER/IMXX                                                  00678800
      TOLRE=1000.0/10.0**IEXP                                           00678900
      DO 5070 I=1,NSCTO                                                 00679000
      IF (IFTP(I).NE.0) GO TO 5070                                      00679100
      QIN(I)=0.0                                                        00679200
      QOUT(I)=0.0                                                       00679300
      IF (QTOT(I).LT.0.0) QOUT(I)=QOUT(I)+QTOT(I)                       00679400
      IF (QTOT(I).GT.0.0) QIN(I)=QIN(I)+QTOT(I)                         00679500
      IS=NSCT(I)                                                        00679600
      ISCT=NSCTL(IS)                                                    00679700
      TLO=TL(I)                                                         00679800
      TLI=TLO+459.688                                                   00679900
      JN=IOSC(9,I)                                                      00680000
      TERM=0.0                                                          00680100
      DEN=0.0                                                           00680200
      IF (JN.EQ.0) GO TO 5020                                           00680300
      DO 5010 J=1,JN                                                    00680400
      JS=IOSC(J,I)                                                      00680500
      COETF=COET(J,I)                                                   00680600
      TERM=TERM+COETF*TN(JS)                                            00680700
      TRMM=COETF*(TN(JS)-TLO)                                           00680800
      IF (TRMM.LT.0.0) QOUT(I)=QOUT(I)+TRMM                             00680900
      IF (TRMM.GT.0.0) QIN(I)=QIN(I)+TRMM                               00681000
      DEN=DEN+COETF                                                     00681100
 5010 CONTINUE                                                          00681200
 5020 IF (NGAPO.EQ.0) GO TO 5030                                        00681300
      DO 5026 J=1,NGAPO                                                 00681400
      JS=NGPJ(J)                                                        00681500
      IF (IS.EQ.NGPI(J)) GO TO 5023                                     00681600
      IF (IS.NE.NGPJ(J)) GO TO 5026                                     00681700
      JS=NGPI(J)                                                        00681800
 5023 JS=NSCTL(JS)                                                      00681900
      TERM=TERM+QGPT(J)*TN(JS)                                          00682000
      TRMM=QGPT(J)*(TN(JS)-TLO)                                         00682100
      IF (TRMM.LT.0.0) QOUT(I)=QOUT(I)+TRMM                             00682200
      IF (TRMM.GT.0.0) QIN(I)=QIN(I)+TRMM                               00682300
      DEN=DEN+QGPT(J)                                                   00682400
 5026 CONTINUE                                                          00682500
 5030 IF (NRSOO.EQ.0) GO TO 5040                                        00682600
      DO 5035 IN=1,3                                                    00682700
      NRSI=NRSO(IN)                                                     00682800
      IF (NRSI.EQ.0) GO TO 5035                                         00682900
      IDX=LONP(IS,NRSI,NRS(1,IN))                                       00683000
      IF (IDX.EQ.0) GO TO 5035                                          00683100
      FRSO=TBLP(FRS(IDX,IN),TIMEC,0.0,IDUM)                             00683200
      ERSO=TBLP(ERS(IDX,IN),TLO,0.0,IDUM)                               00683300
      TRSO=TRS(IDX,IN)                                                  00683400
      IF (TRSO.LT.-460.0) TRSO=TBLP(TRSO,TIMEC,0.0,IDUM)                00683500
      TLJ=TRSO+459.688                                                  00683600
      CDDD=FRSO*ERSO*BQRS(IDX,IN)*(TLJ**3+TLI*TLJ**2+TLJ*TLI**2+TLI**3) 00683700
      TERM=TERM+CDDD*TRSO                                               00683800
      TRMM=CDDD*(TRSO-TLO)                                              00683900
      IF (TRMM.LT.0.0) QOUT(I)=QOUT(I)+TRMM                             00684000
      IF (TRMM.GT.0.0) QIN(I)=QIN(I)+TRMM                               00684100
      DEN=DEN+CDDD                                                      00684200
 5035 CONTINUE                                                          00684300
 5040 IF (NRIOO.EQ.0) GO TO 5050                                        00684400
      DO 5046 IN=1,2                                                    00684500
      NAVTO=NAVT(IN)                                                    00684600
      IF (NAVTO.EQ.0) GO TO 5046                                        00684700
      IDX=LONP(ISCT,NAVTO,NBVT(1,IN))                                   00684800
      IF (IDX.EQ.0) GO TO 5046                                          00684900
      DO 5043 J=1,NAVTO                                                 00685000
      JSCT=NBVT(J,IN)                                                   00685001
      JJ=LONP(JSCT,NAVTO,NBVT(1,IN))                                    00685002
      IF (JJ.EQ.0) GO TO 5043                                           00685003
      TLJ=TN(JSCT)+459.688                                              00685300
      IF (JJ.EQ.IDX) GO TO 5043                                         00685301
      IF (JJ.GT.IDX) BVTO=BVT(IDX,JJ,IN)                                00685302
      IF (JJ.LT.IDX) BVTO=BVT(JJ,IDX,IN)                                00685303
      IF (BVTO.LE.0.0) GO TO 5043                                       00685304
      CDDD=BVTO*(TLJ**3+TLI*TLJ**2+TLJ*TLI**2+TLI**3)                   00685400
      TERM=TERM+CDDD*TN(JSCT)                                           00685500
      TRMM=CDDD*(TN(JSCT)-TLO)                                          00685600
      IF (TRMM.LT.0.0) QOUT(I)=QOUT(I)+TRMM                             00685700
      IF (TRMM.GT.0.0) QIN(I)=QIN(I)+TRMM                               00685800
      DEN=DEN+CDDD                                                      00685900
 5043 CONTINUE                                                          00686000
 5046 CONTINUE                                                          00686100
 5050 IF (NCOO.EQ.0) GO TO 5060                                         00686200
      DO 5056 IN=1,3                                                    00686300
      NCOI=NCO(IN)                                                      00686400
      IF (NCOI.EQ.0) GO TO 5056                                         00686500
      IDX=LONP(IS,NCOI,NC(1,IN))                                        00686600
      IF (IDX.EQ.0) GO TO 5056                                          00686700
      FCO=TBLP(FC(IDX,IN),TIMEC,0.0,IDUM)                               00686800
      TCO=TC(IDX,IN)                                                    00686900
      IF (TCO.LT.-460.0) TCO=TBLP(TCO,TIMEC,0.0,IDUM)                   00687000
      TCOO=TCO-TLO                                                      00687100
      IF (NCI(IDX,IN).LE.0) GO TO 5053                                  00687200
      ICI=NCI(IDX,IN)                                                   00687300
      NICI=NSCTL(ICI)                                                   00687400
      ICJ=NCJ(IDX,IN)                                                   00687500
      NICJ=NSCTL(ICJ)                                                   00687600
      TCOO=(TN(NICI)+TN(NICJ))/2.0                                      00687700
      TCO=TCOO                                                          00687800
 5053 ITCO=ITC(IDX,IN)                                                  00687900
      IF (ITCO.NE.1) HCO=TBLP(HC(IDX,IN),TCOO,0.0,IDUM)                 00688000
      IF (ITCO.EQ.1) HCO=TBLP(HC(IDX,IN),TIMEC,TLO,IDUM)                00688100
      CDDD=FCO*HCO*BQC(IDX,IN)                                          00688200
      TERM=TERM+CDDD*TCO                                                00688300
      TRMM=CDDD*(TCO-TLO)                                               00688400
      IF (TRMM.LT.0.0) QOUT(I)=QOUT(I)+TRMM                             00688500
      IF (TRMM.GT.0.0) QIN(I)=QIN(I)+TRMM                               00688600
      DEN=DEN+CDDD                                                      00688700
 5056 CONTINUE                                                          00688800
 5060 DNUM=TERM+QTOT(I)                                                 00688900
      IF (DEN.EQ.0.0) GO TO 5061                                        00688901
      TN8(I)=DNUM/DEN                                                   00688902
      GO TO 5062                                                        00688903
 5061 IF (DNUM.LT.0.0) TN8(I)=-460.0                                    00689000
      IF (DNUM.EQ.0.0) TN8(I)=TL8(I)                                    00689001
      IF (DNUM.GT.0.0) TN8(I)=10000.0                                   00689002
 5062 DEL8=TN8(I)-TL8(I)                                                00689100
      DL8= ABS(DEL8)                                                    00689200
      DEL=DL8                                                           00689300
      IF (DEL.GE.TOLL) ICONV=1                                          00689400
      IF (DEL.GT.TOLRE) GO TO 5063                                      00689500
      IF (DEL.LT.TOLRM) GO TO 5065                                      00689600
      IF (DEN.EQ.0.0) GO TO 5063                                        00689601
      TN8(I)=TL8(I)+(1.0+FTTT)*DEL8                                     00689700
      GO TO 5065                                                        00689800
 5063 TN8(I)=TL8(I)+(TOLRE/DEL)*DEL8                                    00689900
 5065 TN(I)=TN8(I)                                                      00690000
      TL8(I)=TN8(I)                                                     00690100
      TCR(I)=TN(I)-TL(I)                                                00690200
      TL(I)=TN(I)                                                       00690300
 5070 CONTINUE                                                          00690400
      ITER=ITER+1                                                       00690500
      ITST=ITER-IPNT*(ITER/IPNT)                                        00690600
      IF (ITER.GE.IMAX) ICONV=0                                         00690700
      IF (ICONV.EQ.0) GO TO 6000                                        00690800
      IF (ITST.EQ.0) GO TO 6000                                         00690900
      IF (ITER.EQ.2) GO TO 6000                                         00691000
      GO TO 2000                                                        00691100
C                                                                       00691200
C     PRINT TEMPERATURE SOLUTION                                        00691300
 6000 IF (INPO(35).EQ.3) GO TO 6010                                     00691400
      DO 6005 I=1,NSCTO                                                 00691500
      QRAT(I)=0.0                                                       00691600
      IF (QIN(I).GT.1.0E-40) QRAT(I)=(QIN(I)+QOUT(I))/QIN(I)            00691700
 6005 CONTINUE                                                          00691800
      WRITE (6,600) TIMEC,ITER,NCASE,(NSCT(I),TN(I),                    00691900
     1QIN(I),QOUT(I),QRAT(I),TCR(I),I=1,NSCTO)                          00692000
 6010 IF (NSPTO.EQ.0) GO TO 6030                                        00692100
      DO 6020 I=1,NSPTO                                                 00692200
      IS=NSPT(I)                                                        00692300
      ISCT=NSCTL(IS)                                                    00692400
      SLPO(I)=0.0                                                       00692500
      TL1(I)=QIN(ISCT)                                                  00692600
      TL2(I)=QOUT(ISCT)                                                 00692700
      IF (TL1(I).GT.1.0E-40)                                            00692800
     1SLPO(I)=(TL1(I)+TL2(I))/TL1(I)                                    00692900
      TPD(I)=TN(ISCT)                                                   00693000
 6020 SLP(I)=TCR(ISCT)                                                  00693100
      WRITE (6,600) TIMEC,ITER,NCASE,(NSPT(I),TPD(I),                   00693200
     1TL1(I),TL2(I),SLPO(I),SLP(I),I=1,NSPTO)                           00693300
 6030 IF (ICONV.NE.0) GO TO 2000                                        00693400
 6100 DO 6120 I=1,NSCTO                                                 00693500
      IMTL=LONP(MTLN(I),NMTLO,NMTL)                                     00693600
      RHOH=TBLP(RHO(IMTL),TN(I),0.0,IDUM)                               00693700
      CPP=TBLP(CP(IMTL),TN(I),0.0,IDUM)                                 00693800
      CAP(I)=(ABS(DX(I)*DY(I)*DZ(I))/1728.0)*RHOH*CPP                   00693900
      JN=IOSC(9,I)                                                      00694000
      TERM=0.0                                                          00694100
      TPD(I)=0.0                                                        00694200
      IF (JN.EQ.0) GO TO 6120                                           00694300
      DO 6110 J=1,JN                                                    00694400
      TERM=TERM+COET(J,I)                                               00694500
 6110 CONTINUE                                                          00694600
      IF (TERM.LT.1.0E-20) GO TO 6120                                   00694700
      TERM=(CAP(I)/TERM)*(FTRT/3600.0)                                  00694800
      TPD(I)=TERM                                                       00694900
 6120 CONTINUE                                                          00695000
      WRITE (6,870)                                                     00695100
      WRITE (6,880) NCASE,TITLE,TIMEC                                   00695200
      DO 6130 I=1,NSCTO                                                 00695300
      JN=IOSC(9,I)                                                      00695400
      WRITE (6,881) NSCT(I),TPD(I),CAP(I)                               00695500
      IF (JN.LE.0) GO TO 6130                                           00695600
      IF (JN.LE.4) WRITE (6,882) (NOSC(J,I),COET(J,I),J=1,JN)           00695700
      IF (JN.GT.4) WRITE (6,883) (NOSC(J,I),COET(J,I),J=1,JN)           00695800
 6130 CONTINUE                                                          00695900
C                                                                       00696000
C     EXIT                                                              00696100
 9000 RETURN                                                            00696200
      END                                                               00696300
*DECK OTPT                                                              00696301
C     SUBROUTINE OTPT OF PROGRAM XF0031                                 00696400
C     L.W. FESLER     41-383/530  X4263                                 00696500
C                                                                       00696600
C                *****      *****      *****      *****                 00696700
C                                                                       00696800
C     THIS SUBROUTINE PRINTS THE TEMPERATURE-TIME HISTORY               00696900
C     AND PLOTS THE CRT GRAPHS.                                         00697000
C                                                                       00697100
C                *****      *****      *****      *****                 00697200
C                                                                       00697300
      SUBROUTINE OTPT                                                   00697400
C                                                                       00697500
      EXTERNAL TABL1V                                                   00697501
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00697600
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00697700
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00697800
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00697900
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00698000
     5              ICLOCK,IDOMT,INPP(33)                               00698001
      COMMON /CMN2/ TEMP(1)                                             00698100
      COMMON /CMN9/ NCRTO(5),NCRT(11,50,5),NCSEO,NCSE(300),NCSSO,       00698200
     1              NCSS(99),NCPT(99),NHLDO,NHLD(300),NHRTO,NHRT(300),  00698300
     2              TENRY,TDOWN,YSCLE(2,5),IPCRT                        00698400
C                                                                       00698500
      DIMENSION FMT1(24),FMT2(8),FMT3(15),FMT4(13),FMT5(14),            00698600
     1          FMT6(25),FMT7(26),FMT8(8),BCD(10),IDX(20),IDC(20),      00698700
     2          TT(300),FM30(13)                                        00698800
      DIMENSION FMTQ(5)                                                 00699000
      DIMENSION TITLL(6),ARY(15)                                        00699001
      EQUIVALENCE (FIW,IIW)                                             00699100
C                                                                       00699200
      DATA FMTQ / "(F6.","    ",",F6.","   ",")   " /                   00699300
      DATA FMT1 / 4H(1H0,4H17X,,6H"TIME",2H, ,4H    ,4H(6X,,            00699400
     1            4H"T(",4H,I3,,4H")"),4H,8X,,6H"TIME",2H/1,            00699500
     2            4HH 10,4HX, ",4H    ,4H  , ,4H    ,4H(5X,,            00699600
     3            9H"(DEG F)",1H),2H 1,4HX, ",4H    ,4H  )  /           00699700
      DATA FMT2 / 4H(1H ,4H5X,I,4H4,F1,4H2.3,,4H    ,4HF12.,            00699800
     1            4H3,F1,4H2.3) /                                       00699900
      DATA FMT3 / 4H(1H ,4H10X,,4HI3,2,4HX,  ,4H    ,9H(",(CASE",       00700000
     1            4H    ,4H ,I3,8H,",SECT",1H ,4H,I3,,4H"-",,           00700100
     2            6HA1,")",2H,),4H)    /                                00700200
      DATA FM30 / 4H(1H ,4H15X,,4H    ,9H(",(CASE",1H ,3H,I3,           00700300
     1            8H,",SECT",1H ,4H,I3,,4H"-",,4HA1, ,4H")"),           00700400
     2            4H)    /                                              00700500
      DATA FMT4 / 4H(1H ,4H10X,,7H"NCASE",1H,,4HI4,4,4HX   ,            00700600
     1            4H    ,5H(",(",3H,I3,4H,",",4H,A1,,4H")"),            00700700
     2            4H)    /                                              00700800
      DATA FMT5 / 4H(1H ,4H10X,,7H"NCASE",1H,,4HI4,4,4HX,  ,            00700900
     1            4H    ,5H(",(",3H,I3,4H,"-",4H,I3,,4H",",,            00701000
     2            4HA1, ,5H")")) /                                      00701100
      DATA FMT6 / 4H(1H0,4H17X,,6H"TIME",2H, ,4H    ,4H(5X,,            00701200
     1            7H"LOAD(",1H,,4HI3, ,4H")"),4H,8X,,6H"TIME",          00701300
     2            4H /1H,4H 10X,4H,  ",4H    ,4H  , ,4H    ,            00701400
     3            4H(9X,,7H"(BTU)",1H),4H,1X,,4H   ",4H    ,            00701500
     4            4H  )  /                                              00701600
      DATA FMT7 / 4H(1H0,4H17X,,6H"TIME",2H, ,4H    ,4H(5X,,            00701700
     1            7H"RATE(",1H,,4HI3, ,4H")"),4H,8X,,6H"TIME",          00701800
     2            4H /1H,4H 10X,4H,  ",4H    ,4H  , ,4H    ,            00701900
     3            4H(5X,,10H"(BTU/SEC),2H"),1H ,4H,1X,,4H   ",          00702000
     4            4H    ,4H  )  /                                       00702100
      DATA FMT8 / 4H(1H ,4H5X,I,4H4,F1,4H2.3,,4H    ,4HF14.,            00702200
     1            4H5,F1,4H2.3) /                                       00702300
      DATA BCD / 1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ /              00702400
      DATA DSEC,DHRS / 6H(SEC)",6H(HRS)" /                              00702500
      DATA INBR / 33333333333333333333B /                               00702600
      DATA FMT11,FMT12 / "(1H0","(1H+" /                                00702700
C                                                                       00702800
  100 FORMAT(1H15X,"TEMPERATURE VERSUS TIME HISTORY"/                   00702900
     11H 5X,"NCASE",I4)                                                 00703000
  110 FORMAT(1H 48X,"NCASE",I4,5X,"SECTION",I6)                         00703100
  120 FORMAT(1H1)                                                       00703200
  200 FORMAT(I6,5X,"0",5X,"1 QDOT"/I6)                                  00703300
  300 FORMAT(1H 10X,15A4)                                               00703400
  302 FORMAT(1H 10X,"MULTICASE-MULTISECTION TEMPERATURE HISTORY GRAPH") 00703500
  303 FORMAT(1H 10X,"MULTISECTION TEMPERATURE HISTORY GRAPH")           00703600
  304 FORMAT(1H 10X,"MULTISECTION DELTA TEMPETATURE HISTORY GRAPH")     00703700
  305 FORMAT(1H 10X,"MULTISECTION HEATING LOAD HISTORY GRAPH")          00703800
  306 FORMAT(1H 10X,"MULTISECTION HEATING RATE HISTORY GRAPH")          00703900
  500 FORMAT(1H15X,"HEATING LOAD VERSUS TIME HISTORY"/                  00704000
     11H 5X,"NCASE",I4)                                                 00704100
  510 FORMAT(1H15X,"HEATING RATE VERSUS TIME HISTORY"/                  00704200
     11H 5X,"NCASE",I4)                                                 00704300
  600 FORMAT(48X,F6.0,4X)                                               00704400
  610 FORMAT(15A4)                                                      00704401
  620 FORMAT(6A10)                                                      00704402
C                                                                       00704500
C     INITIALIZE                                                        00704600
 1000 REWIND 2                                                          00704700
      REWIND 3                                                          00704800
      REWIND 4                                                          00704900
      REWIND 8                                                          00705000
      REWIND 9                                                          00705100
      REWIND 10                                                         00705200
      IHRS=INPO(34)                                                     00705300
      IPNT=IABS(INPO(35))                                               00705400
      IF (IPNT.GT.99) IPNT=IPNT-100                                     00705401
      IF (IPNT.GT.3) IPNT=0                                             00705500
      ICRT=INPO(28)                                                     00705600
      IF (ICRT.LT.-5) ICRT=0                                            00705700
      ICRA=IABS(ICRT)                                                   00705800
      IF (ICRA.GT.5) ICRA=0                                             00705900
      FMT1(15)=DSEC                                                     00706000
      FMT1(23)=DSEC                                                     00706100
      FMT6(16)=DSEC                                                     00706200
      FMT6(24)=DSEC                                                     00706300
      FMT7(16)=DSEC                                                     00706400
      FMT7(25)=DSEC                                                     00706500
      IF (IHRS.NE.1) GO TO 1010                                         00706600
      FMT1(15)=DHRS                                                     00706700
      FMT1(23)=DHRS                                                     00706800
      FMT6(16)=DHRS                                                     00706900
      FMT6(24)=DHRS                                                     00707000
      FMT7(16)=DHRS                                                     00707100
      FMT7(25)=DHRS                                                     00707200
 1010 NMAXO=NSCTO                                                       00707300
      IF (IPNT.EQ.3) NMAXO=NSPTO                                        00707400
      IF (NCRTO(2).NE.0.OR.NCRTO(3).NE.0) NMAXO=NSCTO                   00707500
      IF (NCRTO(1).NE.0) NMAXO=MAX0(2050,NMAXO)                         00707600
      IF (NMAXO.LT.11) NMAXO=11                                         00707700
 1020 NWDS=NOPT*(NMAXO+1)                                               00707800
      IF (NWDS.GT.20000) NWDS=20000                                     00707900
      WRITE (10) (TEMP(I),I=1,NWDS)                                     00708100
      REWIND 10                                                         00708200
      YB=0.0                                                            00708201
      YT=0.0                                                            00708202
      IF (ICRA.EQ.0) GO TO 2000                                         00708300
      IF (IPCRT.EQ.0) CALL CAMRAV(9)                                    00708400
      IPCRT=1                                                           00708401
      CALL SCOUTV                                                       00708500
      IBB=24                                                            00708600
      IYPP=0                                                            00708700
      ICTT=0                                                            00708800
      IF (ICRA.EQ.3.OR.ICRA.EQ.5) ICTT=1                                00708900
      IF (ICRA.LT.4) GO TO 2000                                         00709000
      IBB=48                                                            00709100
      IYPP=26                                                           00709200
      IXR=8                                                             00709300
      IYR=9                                                             00709400
      IXR1=8+13*14                                                      00709500
      CALL CHSIZV(2,3)                                                  00709600
      CALL RITSTV(14,26,TABL1V)                                         00709700
      ENCODE(60,610,ARY) TITLE                                          00709701
      DECODE(60,620,ARY) TITLL                                          00709702
C                                                                       00709800
C     TEMPERATURE HISTORY                                               00709900
 2000 IN1=1                                                             00710000
      IN2=1                                                             00710100
      IF (IPNT.GT.2) IN1=2                                              00710200
      IF (NSPTO.NE.0) IN2=2                                             00710300
      IF (IN1.GT.IN2) GO TO 3000                                        00710400
      DO 2090 IN=IN1,IN2                                                00710500
      IF (IN.EQ.1) NUSE=NSCTO                                           00710600
      IF (IN.EQ.2) NUSE=NSPTO                                           00710700
      IT=IN+1                                                           00710800
      NREAD=NWDS/NOPT-1                                                 00710900
      NUSED=0                                                           00711000
      IF (NREAD.GT.NUSE) NREAD=NUSE                                     00711100
      IF (NREAD.LT.NUSE) NREAD=(NREAD/5)*5                              00711200
 2010 JEND=NOPT*NREAD-1                                                 00711300
      IF (NOPT.EQ.1) JEND=JEND+1                                        00711400
      DO 2020 I=1,NOPT                                                  00711500
      JREF=NOPT+I-1                                                     00711600
      IF (NUSED.EQ.0) READ (IT) TEMP(I),(TEMP(JREF+J),J=1,JEND,NOPT)    00711700
      IF (NUSED.NE.0) READ (IT) TEMP(I),(DUM,K=1,NUSED),                00711800
     1(TEMP(JREF+J),J=1,JEND,NOPT)                                      00711900
 2020 CONTINUE                                                          00712000
      DO 2080 I=1,NREAD,5                                               00712100
      WRITE (6,100) NCASE                                               00712200
      IS=NUSED+I                                                        00712300
      IW=NREAD-I+1                                                      00712400
      IF (IW.GT.5) IW=5                                                 00712500
      IE=IS+IW-1                                                        00712600
      IIW=INBR+IW                                                       00712700
      FMT1(5)=FIW                                                       00712800
      FMT1(17)=FIW                                                      00712900
      FMT2(5)=FIW                                                       00713000
      KREF=NOPT*I-1                                                     00713100
      KEND=NOPT*IW-1                                                    00713200
      IF (NOPT.EQ.1) KEND=KEND+1                                        00713300
      LL=1                                                              00713400
      IF (NOPT.GT.37) LL=2+(NOPT-38)/40                                 00713500
      FMT1(1)=FMT11                                                     00713600
      DO 2025 L=1,LL                                                    00713700
      J1=1+(L-1)*40                                                     00713800
      IF (L.GT.1) J1=J1-3                                               00713900
      J2=J1+39                                                          00714000
      IF (L.EQ.1) J2=J2-3                                               00714100
      IF (J2.GT.NOPT) J2=NOPT                                           00714200
      IF (L.GT.1) WRITE (6,120)                                         00714300
      IF (IN.EQ.1) WRITE (6,FMT1) (NSCT(J),J=IS,IE)                     00714400
      IF (IN.EQ.2) WRITE (6,FMT1) (NSPT(J),J=IS,IE)                     00714500
      WRITE (6,FMT2) (J,TEMP(J),(TEMP(KREF+K+J),K=1,KEND,NOPT),         00714600
     1TEMP(J),J=J1,J2)                                                  00714700
      FMT1(1)=FMT12                                                     00714800
 2025 CONTINUE                                                          00714900
 2030 IF (ICRA.NE.1) GO TO 2080                                         00715000
      IDXO=IS                                                           00715100
      DO 2060 K=1,KEND,NOPT                                             00715200
      YMIN=1.0E30                                                       00715300
      YMAX=-1.0E30                                                      00715400
      KREFO=KREF+K                                                      00715500
      DO 2040 J=1,NOPT                                                  00715600
      TEMPO=TEMP(KREFO+J)                                               00715700
      YMIN=AMIN1(YMIN,TEMPO)                                            00715800
 2040 YMAX=AMAX1(YMAX,TEMPO)                                            00715900
      IF ((YMAX-YMIN).LT.0.1) YMAX=YMAX+0.1                             00716000
      DYT=YMAX-YMIN                                                     00716100
      DY=1.0E-06                                                        00716200
      DO 2045 L=1,8                                                     00716300
      DNB1=(1.5E-05)*10.0**L                                            00716400
      DNB2=(8.0/3.0)*DNB1                                               00716500
      DNB3=2.0*DNB2                                                     00716600
      IF (DYT.GT.DNB1) DY=DNB1/6.0                                      00716700
      IF (DYT.GT.DNB2) DY=DNB2/8.0                                      00716800
      IF (DYT.GT.DNB3) DY=DNB3/8.0                                      00716900
 2045 CONTINUE                                                          00717000
      YB=DY*(AINT(YMIN/DY))                                             00717100
      IF (YMIN.LT.0.0) YB=YB-DY                                         00717200
      YT=DY*(AINT(YMAX/DY)+1.0)                                         00717300
      IF ((YT-YB).LT.0.1) YT=YT+0.1                                     00717400
      XL=TEMP(1)                                                        00717500
      XR=TEMP(NOPT)                                                     00717600
      CALL SETMIV(24,0,IBB,24)                                          00717700
      CALL DXDYV(1,XL,XR,DXX,MM,II,NXX,10.0,IER)                        00717800
      YT=YTFIX(YT)                                                      00717801
      CALL DXDYV(2,YB,YT,DYY,NN,JJ,NYY,10.0,IER)                        00717900
      CALL GRID1V(-1,XL,XR,YB,YT,DXX,DYY,MM,NN,-II,-JJ,NXX,NYY)         00718000
      IF (IHRS.NE.1) CALL PRINTV(-14,14HTIME - SECONDS,450,0)           00718100
      IF (IHRS.EQ.1) CALL PRINTV(-12,12HTIME - HOURS,450,0)             00718200
      CALL APRNTV(0,-14,-18,18HTEMPERATURE  DEG F,0,590)                00718300
      CALL SCSETV(0,20)                                                 00718400
      WRITE (16,300) TITLE                                              00718500
      CALL SCSETV(1,24)                                                 00718600
      IF (IN.EQ.1) NSCTN=NSCT(IDXO)                                     00718700
      IF (IN.EQ.2) NSCTN=NSPT(IDXO)                                     00718800
      IDXO=IDXO+1                                                       00718900
      WRITE (16,110) NCASE,NSCTN                                        00719000
      DO 2060 J=1,NOPT                                                  00719100
      NX1=NXV(TEMP(J))                                                  00719200
      NY1=NYV(TEMP(KREFO+J))                                            00719300
      IF (J.EQ.1) GO TO 2050                                            00719400
      CALL LINEV(NX1,NY1,NX2,NY2)                                       00719500
      CALL LINEV(NX1,NY1,NX2,NY2)                                       00719600
 2050 NX2=NX1                                                           00719700
      NY2=NY1                                                           00719800
 2060 CONTINUE                                                          00719900
 2080 CONTINUE                                                          00720000
      NUSED=NUSED+NREAD                                                 00720100
      IF (NUSED.EQ.NUSE) GO TO 2090                                     00720200
      NR=NUSE-NUSED                                                     00720300
      IF (NREAD.GT.NR) NREAD=NR                                         00720400
      IF ((NUSED+NREAD).LT.NUSE) NREAD=(NREAD/5)*5                      00720500
      REWIND IT                                                         00720600
      GO TO 2010                                                        00720700
 2090 CONTINUE                                                          00720800
C                                                                       00720900
C     MULTICASE TEMPERATURE GRAPHS                                      00721000
 3000 IF (NCRTOO.EQ.0) GO TO 9000                                       00721100
      IF (NCSEO.EQ.0) GO TO 4000                                        00721200
      NGPH=NCRTO(1)                                                     00721300
      ISKIP=0                                                           00721400
      DO 3090 I=1,NGPH                                                  00721500
      IF (ISKIP.EQ.1) GO TO 3002                                        00721600
      IF (ISKIP.EQ.2) GO TO 3001                                        00721700
      REWIND 4                                                          00721800
      IW=0                                                              00721900
      IWO=0                                                             00722000
      NOPX=0                                                            00722100
      NGPHO=NCRT(1,I,1)                                                 00722200
      IF (NGPHO.LE.100) GO TO 3002                                      00722300
      IF ((NGPHO-100).LE.NCASE) GO TO 3002                              00722400
      IF (I.EQ.NGPH) GO TO 3090                                         00722500
      IF (NCRT(1,I+1,1).LE.0) ISKIP=2                                   00722600
      GO TO 3090                                                        00722700
 3001 ISKIP=0                                                           00722800
      GO TO 3090                                                        00722900
 3002 DO 3010 J=2,11,2                                                  00723000
      IF (NCRT(J+1,I,1).LE.0) GO TO 3010                                00723100
      NCSO=NCRT(J,I,1)                                                  00723200
      DO 3005 K=1,NCSSO                                                 00723300
      IF (NCSO.NE.NCSS(K)) GO TO 3005                                   00723400
      IW=IW+1                                                           00723500
      IDX(IW)=NCRT(J+1,I,1)                                             00723600
      IDC(IW)=0                                                         00723700
      IDX(IW+10)=NCSO                                                   00723800
      IDC(IW+10)=NCPT(K)                                                00723900
      NOPX=MAX0(NOPX,NCPT(K))                                           00724000
      IF (NCSO.EQ.NCASE) IWO=1                                          00724100
 3005 CONTINUE                                                          00724200
 3010 CONTINUE                                                          00724300
      IF (I.EQ.NGPH) GO TO 3015                                         00724400
      IF (NCRT(1,I+1,1).GT.0) GO TO 3015                                00724500
      ISKIP=1                                                           00724600
      GO TO 3090                                                        00724700
 3015 ISKIP=0                                                           00724800
      IW1=MIN0(IW,5)                                                    00724900
      IW2=0                                                             00725000
      IF (IW.GT.5) IW2=IW-5                                             00725100
      IF (IWO.EQ.0) GO TO 3090                                          00725200
      IIW=INBR+IW1                                                      00725300
      FMT3(5)=FIW                                                       00725400
      IIW=INBR+IW2                                                      00725500
      FM30(3)=FIW                                                       00725600
      DO 3045 J=1,NCSSO                                                 00725700
      READ (4) NCTR,NCASEO,NCSEO,(NCSE(K),K=1,NCSEO)                    00725800
      IWS=0                                                             00725900
      NOPP=NCPT(J)                                                      00726000
      DO 3020 K=1,IW                                                    00726100
      IF (NCASEO.NE.IDX(K+10)) GO TO 3020                               00726200
      IDC(K)=LONP(IDX(K),NCSEO,NCSE)                                    00726300
      IWS=1                                                             00726400
 3020 CONTINUE                                                          00726500
      DO 3040 K=1,NOPP                                                  00726600
      READ (4) TIMED,(TT(L),L=1,NCSEO)                                  00726700
      IF (IWS.EQ.0) GO TO 3040                                          00726800
      DO 3030 L=1,IW                                                    00726900
      IF (NCASEO.NE.IDX(L+10)) GO TO 3030                               00727000
      ISS=IDC(L)                                                        00727100
      ISX=NOPX*(2*L-2)                                                  00727200
      ISY=ISX+NOPX                                                      00727300
      TEMP(ISX+K)=TIMED                                                 00727400
      TEMP(ISY+K)=TT(ISS)                                               00727500
 3030 CONTINUE                                                          00727600
 3040 CONTINUE                                                          00727700
 3045 CONTINUE                                                          00727800
 3050 XMIN=1.0E30                                                       00727900
      XMAX=-1.0E30                                                      00728000
      YMIN=1.0E30                                                       00728100
      YMAX=-1.0E30                                                      00728200
      DO 3055 K=1,IW                                                    00728300
      NOPP=IDC(K+10)                                                    00728400
      ISX=NOPX*(2*K-2)                                                  00728500
      ISY=ISX+NOPX                                                      00728600
      DO 3055 J=1,NOPP                                                  00728700
      TEMPO=TEMP(ISX+J)                                                 00728800
      XMIN=AMIN1(XMIN,TEMPO)                                            00728900
      XMAX=AMAX1(XMAX,TEMPO)                                            00729000
      TEMPO=TEMP(ISY+J)                                                 00729100
      YMIN=AMIN1(YMIN,TEMPO)                                            00729200
      YMAX=AMAX1(YMAX,TEMPO)                                            00729300
 3055 CONTINUE                                                          00729400
      IF (ICRA.LT.3) GO TO 3057                                         00729500
      IF (ICRA.EQ.4) GO TO 3057                                         00729600
      YB=YSCLE(1,1)                                                     00729700
      YT=YSCLE(2,1)                                                     00729800
      IF (YB.NE.0.0) GO TO 3065                                         00729900
      IF (YT.NE.0.0) GO TO 3065                                         00730000
 3057 IF ((YMAX-YMIN).LT.0.1) YMAX=YMAX+0.1                             00730100
      DYT=YMAX-YMIN                                                     00730200
      DY=1.0E-06                                                        00730300
      DO 3060 J=1,8                                                     00730400
      DNB1=(1.5E-05)*10.0**J                                            00730500
      DNB2=(8.0/3.0)*DNB1                                               00730600
      DNB3=2.0*DNB2                                                     00730700
      IF (DYT.GT.DNB1) DY=DNB1/6.0                                      00730800
      IF (DYT.GT.DNB2) DY=DNB2/8.0                                      00730900
      IF (DYT.GT.DNB3) DY=DNB3/8.0                                      00731000
 3060 CONTINUE                                                          00731100
      IF (ICTT.EQ.1.AND.YB.NE.0.0) GO TO 3062                           00731200
      YB=DY*(AINT(YMIN/DY))                                             00731300
      IF (YMIN.LT.0.0) YB=YB-DY                                         00731400
 3062 IF (ICTT.EQ.1.AND.YT.NE.0.0) GO TO 3065                           00731500
      YT=DY*(AINT(YMAX/DY)+1.0)                                         00731600
      IF ((YT-YB).LT.0.1) YT=YT+0.1                                     00731700
 3065 XL=XMIN                                                           00731800
      XR=XMAX                                                           00731900
      IF (IW.LE.5) CALL SETMIV(24,0,IBB,24)                             00732000
      IF (IW.GT.5) CALL SETMIV(24,0,IBB,48)                             00732100
      CALL DXDYV(1,XL,XR,DXX,MM,II,NXX,10.0,IER)                        00732200
      YT=YTFIX(YT)                                                      00732201
      CALL DXDYV(2,YB,YT,DYY,NN,JJ,NYY,10.0,IER)                        00732300
      CALL GRID1V(-1,XL,XR,YB,YT,DXX,DYY,MM,NN,-II,-JJ,NXX,NYY)         00732400
      IF (IHRS.NE.1) CALL PRINTV(-14,14HTIME - SECONDS,450,IYPP)        00732500
      IF (IHRS.EQ.1) CALL PRINTV(-12,12HTIME - HOURS,450,IYPP)          00732600
      IF (ICRT.LT.0) M=SYMB(TENRY,TDOWN,ICRA)                           00732700
      CALL APRNTV(0,-14,-18,18HTEMPERATURE  DEG F,0,590)                00732800
      CALL SCSETV(0,20)                                                 00732900
      IF (ICRA.LT.4) WRITE (16,300) TITLE                               00733000
      IF (ICRA.GE.4) WRITE (16,302)                                     00733100
      CALL SCSETV(1,24)                                                 00733200
      WRITE (16,FMT3) NCASE,(IDX(J+10),IDX(J),BCD(J),J=1,IW1)           00733300
      CALL SCSETV(2,24)                                                 00733400
      IF (IW.GT.5) WRITE (16,FM30) (IDX(J+10),IDX(J),BCD(J),J=6,IW)     00733500
      IF (ICRA.GE.4)                                                    00733600
     *CALL RITE2V(IXR,IYR,1023,90,2,13,1,"FIGURE    .  ",IER)           00733700
      IF (ICRA.GE.4)                                                    00733800
     *CALL RITE2V(IXR1,IYR,1023,90,2,60,1,TITLL,IER)                    00733900
      DO 3080 K=1,IW                                                    00734000
      NOPP=IDC(K+10)                                                    00734100
      ISX=NOPX*(2*K-2)                                                  00734200
      ISY=ISX+NOPX                                                      00734300
      ISM=16+K                                                          00734400
      IF (K.EQ.10) ISM=33                                               00734500
      INM=100+10*(K-1)                                                  00734501
      DO 3080 J=1,NOPP                                                  00734600
      NX1=NXV(TEMP(ISX+J))                                              00734700
      NY1=NYV(TEMP(ISY+J))                                              00734800
      IF (J.EQ.1) GO TO 3070                                            00734900
      IF (NX1.LT.INM) GO TO 3068                                        00735000
 3067 INM=INM+100                                                       00735001
      IF (NX1.GT.INM) GO TO 3067                                        00735002
      CALL PLOTV(NX1,NY1,ISM)                                           00735003
 3068 CALL LINEV(NX1,NY1,NX2,NY2)                                       00735100
      CALL LINEV(NX1,NY1,NX2,NY2)                                       00735200
 3070 NX2=NX1                                                           00735300
      NY2=NY1                                                           00735400
 3080 CONTINUE                                                          00735500
 3090 CONTINUE                                                          00735600
C                                                                       00735700
C     MULTISECTION TEMPERATURE GRAPHS                                   00735800
 4000 DO 4090 IN=1,2                                                    00735900
      INO=IN+1                                                          00736000
      IF (NCRTO(INO).EQ.0) GO TO 4090                                   00736100
      NGPH=NCRTO(INO)                                                   00736200
      DO 4080 I=1,NGPH                                                  00736300
      REWIND 2                                                          00736400
      IW=0                                                              00736500
      DO 4010 J=2,11,IN                                                 00736600
      IS=NCRT(J,I,INO)                                                  00736700
      IF (IS.LE.0) GO TO 4010                                           00736800
      ISCT=LONP(IS,NSCTO,NSCT)                                          00736900
      IF (ISCT.LE.0) GO TO 4010                                         00737000
      IW=IW+1                                                           00737100
      IDX(IW)=IS                                                        00737200
      IF (IN.EQ.1) GO TO 4010                                           00737300
      JS=NCRT(J+1,I,INO)                                                00737400
      IF (JS.LE.0) JS=IS                                                00737500
      JSCT=LONP(JS,NSCTO,NSCT)                                          00737600
      IF (JSCT.LE.0) JS=IS                                              00737700
      IDX(IW+5)=JS                                                      00737800
 4010 CONTINUE                                                          00737900
      IF (IW.EQ.0) GO TO 4080                                           00738000
      IIW=INBR+64*(IW/10)+IW-10*(IW/10)                                 00738100
      IF (IN.EQ.1) FMT4(7)=FIW                                          00738200
      IF (IN.EQ.2) FMT5(7)=FIW                                          00738300
      YMIN=1.0E30                                                       00738400
      YMAX=-1.0E30                                                      00738500
      DO 4030 J=1,NOPT                                                  00738600
      READ (2) TEMP(J),(TT(K),K=1,NSCTO)                                00738700
      DO 4030 K=1,IW                                                    00738800
      IS=IDX(K)                                                         00738900
      ISCT=LONP(IS,NSCTO,NSCT)                                          00739000
      KREF=NOPT*K                                                       00739100
      TEMP(KREF+J)=TT(ISCT)                                             00739200
      IF (IN.EQ.1) GO TO 4020                                           00739300
      JS=IDX(K+5)                                                       00739400
      IF (JS.LE.0) GO TO 4020                                           00739500
      JSCT=LONP(JS,NSCTO,NSCT)                                          00739600
      TEMP(KREF+J)=TEMP(KREF+J)-TT(JSCT)                                00739700
 4020 YMIN=AMIN1(YMIN,TEMP(KREF+J))                                     00739800
      YMAX=AMAX1(YMAX,TEMP(KREF+J))                                     00739900
 4030 CONTINUE                                                          00740000
      IF (ICRA.LT.3) GO TO 4035                                         00740100
      IF (ICRA.EQ.4) GO TO 4035                                         00740200
      YB=YSCLE(1,INO)                                                   00740300
      YT=YSCLE(2,INO)                                                   00740400
      IF (YB.NE.0.0) GO TO 4045                                         00740500
      IF (YT.NE.0.0) GO TO 4045                                         00740600
 4035 IF ((YMAX-YMIN).LT.0.1) YMAX=YMAX+0.1                             00740700
      DYT=YMAX-YMIN                                                     00740800
      DY=1.0E-06                                                        00740900
      DO 4040 J=1,8                                                     00741000
      DNB1=(1.5E-05)*10.0**J                                            00741100
      DNB2=(8.0/3.0)*DNB1                                               00741200
      DNB3=2.0*DNB2                                                     00741300
      IF (DYT.GT.DNB1) DY=DNB1/6.0                                      00741400
      IF (DYT.GT.DNB2) DY=DNB2/8.0                                      00741500
      IF (DYT.GT.DNB3) DY=DNB3/8.0                                      00741600
 4040 CONTINUE                                                          00741700
      IF (ICTT.EQ.1.AND.YB.NE.0.0) GO TO 4042                           00741800
      YB=DY*(AINT(YMIN/DY))                                             00741900
      IF (YMIN.LT.0.0) YB=YB-DY                                         00742000
 4042 IF (ICTT.EQ.1.AND.YT.NE.0.0) GO TO 4045                           00742100
      YT=DY*(AINT(YMAX/DY)+1.0)                                         00742200
      IF ((YT-YB).LT.0.1) YT=YT+0.1                                     00742300
 4045 XL=TEMP(1)                                                        00742400
      XR=TEMP(NOPT)                                                     00742500
      CALL SETMIV(24,0,IBB,24)                                          00742600
      CALL DXDYV(1,XL,XR,DXX,MM,II,NXX,10.0,IER)                        00742700
      YT=YTFIX(YT)                                                      00742701
      CALL DXDYV(2,YB,YT,DYY,NN,JJ,NYY,10.0,IER)                        00742800
      CALL GRID1V(-1,XL,XR,YB,YT,DXX,DYY,MM,NN,-II,-JJ,NXX,NYY)         00742900
      IF (IHRS.NE.1) CALL PRINTV(-14,14HTIME - SECONDS,450,IYPP)        00743000
      IF (IHRS.EQ.1) CALL PRINTV(-12,12HTIME - HOURS,450,IYPP)          00743100
      IF (ICRT.LT.0) M=SYMB(TENRY,TDOWN,ICRA)                           00743200
      IF (IN.EQ.1) CALL APRNTV(0,-14,-18,18HTEMPERATURE  DEG F,0,590)   00743300
      IF (IN.EQ.2) CALL APRNTV(0,-14,-29,                               00743400
     129HTEMPERATURE DIFFERENCE  DEG F,0,680)                           00743500
      CALL SCSETV(0,20)                                                 00743600
      IF (ICRA.LT.4) WRITE (16,300) TITLE                               00743700
      IF (ICRA.GE.4.AND.IN.EQ.1) WRITE (16,303)                         00743800
      IF (ICRA.GE.4.AND.IN.EQ.2) WRITE (16,304)                         00743900
      CALL SCSETV(1,24)                                                 00744000
      IF (IN.EQ.1) WRITE (16,FMT4) NCASE,(IDX(J),BCD(J),J=1,IW)         00744100
      IF (IN.EQ.2) WRITE (16,FMT5) NCASE,(IDX(J),IDX(J+5),              00744200
     1BCD(J),J=1,IW)                                                    00744300
      IF (ICRA.GE.4)                                                    00744400
     *CALL RITE2V(IXR,IYR,1023,90,2,13,1,"FIGURE    .  ",IER)           00744500
      IF (ICRA.GE.4)                                                    00744600
     *CALL RITE2V(IXR1,IYR,1023,90,2,60,1,TITLL,IER)                    00744700
      DO 4070 K=1,IW                                                    00744800
      KREF=NOPT*K                                                       00744900
      ISM=16+K                                                          00745000
      IF (K.EQ.10) ISM=33                                               00745100
      INM=100+10*(K-1)                                                  00745101
      DO 4070 J=1,NOPT                                                  00745200
      NX1=NXV(TEMP(J))                                                  00745300
      NY1=NYV(TEMP(KREF+J))                                             00745400
      IF (J.EQ.1) GO TO 4060                                            00745500
      IF (NX1.LT.INM) GO TO 4058                                        00745600
      INM=INM+100                                                       00745601
      CALL PLOTV(NX1,NY1,ISM)                                           00745602
 4058 CALL LINEV(NX1,NY1,NX2,NY2)                                       00745700
      CALL LINEV(NX1,NY1,NX2,NY2)                                       00745800
 4060 NX2=NX1                                                           00745900
      NY2=NY1                                                           00746000
 4070 CONTINUE                                                          00746100
 4080 CONTINUE                                                          00746200
 4090 CONTINUE                                                          00746300
C                                                                       00746400
C     HEATING LOAD AND RATE HISTORY                                     00746500
 5000 IN1=1                                                             00746600
      IN2=1                                                             00746700
      IF (NHLDO.EQ.0) IN1=2                                             00746800
      IF (NHRTO.NE.0) IN2=2                                             00746900
      IF (IN1.GT.IN2) GO TO 9000                                        00747000
      DO 5090 IN=IN1,IN2                                                00747100
      IF (IN.EQ.1) NUSE=NHLDO                                           00747200
      IF (IN.EQ.2) NUSE=NHRTO                                           00747300
      IT=IN+7                                                           00747400
      INO=IN+3                                                          00747500
      NUSEO=0                                                           00747600
      NUSED=0                                                           00747700
      NREAD=NWDS/NOPT-1                                                 00747800
      IF (NREAD.GT.NUSE) NREAD=NUSE                                     00747900
      NGPH=NCRTO(INO)                                                   00748000
      DO 5080 I=1,NGPH                                                  00748100
      IS=NCRT(7,I,INO)                                                  00748200
      IW=NCRT(8,I,INO)                                                  00748300
      IF (IW.EQ.0) GO TO 5080                                           00748400
      IIW=INBR+IW                                                       00748500
      FMT6(5)=FIW                                                       00748600
      FMT6(18)=FIW                                                      00748700
      FMT7(5)=FIW                                                       00748800
      FMT7(18)=FIW                                                      00748900
      FMT8(5)=FIW                                                       00749000
      FMT4(7)=FIW                                                       00749100
      IE=IS+IW-1                                                        00749200
      IF (NUSED.EQ.0) GO TO 5010                                        00749300
      IF (IE.LE.NUSED) GO TO 5030                                       00749400
      NUSED=NUSED-IW                                                    00749500
      NDEL=NUSE-NUSED                                                   00749600
      IF (NREAD.GT.NDEL) NREAD=NDEL                                     00749700
 5010 JEND=NOPT*NREAD-1                                                 00749800
      DO 5020 J=1,NOPT                                                  00749900
      JREF=NOPT+J-1                                                     00750000
      IF (NUSED.EQ.0) READ (IT) TEMP(J),(TEMP(JREF+K),K=1,JEND,NOPT)    00750100
      IF (NUSED.NE.0) READ (IT) TEMP(J),(DUM,L=1,NUSED),                00750200
     1(TEMP(JREF+K),K=1,JEND,NOPT)                                      00750300
 5020 CONTINUE                                                          00750400
      NUSEO=NUSED                                                       00750500
      NUSED=NUSED+NREAD                                                 00750600
 5030 KREF=NOPT*(IS-NUSEO)-1                                            00750700
      KEND=NOPT*(IW-NUSEO)-1                                            00750800
      IF (IN.EQ.1) WRITE (6,500) NCASE                                  00750900
      IF (IN.EQ.2) WRITE (6,510) NCASE                                  00751000
      IF (IN.EQ.1) WRITE (6,FMT6) (NHLD(J),J=IS,IE)                     00751100
      IF (IN.EQ.2) WRITE (6,FMT7) (NHRT(J),J=IS,IE)                     00751200
      WRITE (6,FMT8) (J,TEMP(J),(TEMP(KREF+K+J),K=1,KEND,NOPT),         00751300
     1TEMP(J),J=1,NOPT)                                                 00751400
      IF (IN.NE.2) GO TO 5040                                           00751500
      IF (NCRT(1,I,INO).LT.100) GO TO 5040                              00751600
      ICTR=1                                                            00751700
      DO 5035 K=1,KEND,NOPT                                             00751800
      KREFO=KREF+K                                                      00751900
      ICTR=ICTR+1                                                       00752000
      PUNCH 200,NCRT(ICTR,I,INO),NOPT                                   00752100
      DO 5035 J=1,NOPT                                                  00752200
      TIME=TEMP(J)                                                      00752300
      QDOT=TEMP(KREFO+J)                                                00752400
      IW=1                                                              00752500
      IF (TIME.LT.100.0) IW=2                                           00752600
      IF (TIME.LT.10.0) IW=3                                            00752700
      IIW=INBR+IW                                                       00752800
      FMTQ(2)=FIW                                                       00752900
      IW=1                                                              00753000
      IF (QDOT.LT.100.0) IW=2                                           00753100
      IF (QDOT.LT.10.0) IW=3                                            00753200
      IIW=INBR+IW                                                       00753300
      FMTQ(4)=FIW                                                       00753400
      PUNCH FMTQ,TIME,QDOT                                              00753500
 5035 CONTINUE                                                          00753600
 5040 IF (ICRA.LT.2) GO TO 5080                                         00753700
      DO 5045 J=1,IW                                                    00753800
      IDXO=IS+J-1                                                       00753900
      IF (IN.EQ.1) IDX(J)=NHLD(IDXO)                                    00754000
      IF (IN.EQ.2) IDX(J)=NHRT(IDXO)                                    00754100
 5045 CONTINUE                                                          00754200
      YMIN=1.0E30                                                       00754300
      YMAX=-1.0E30                                                      00754400
      DO 5050 K=1,KEND,NOPT                                             00754500
      KREFO=KREF+K                                                      00754600
      DO 5050 J=1,NOPT                                                  00754700
      TEMPO=TEMP(KREFO+J)                                               00754800
      YMIN=AMIN1(YMIN,TEMPO)                                            00754900
      YMAX=AMAX1(YMAX,TEMPO)                                            00755000
 5050 CONTINUE                                                          00755100
      IF (ICRA.LT.3) GO TO 5055                                         00755200
      IF (ICRA.EQ.4) GO TO 5055                                         00755300
      YB=YSCLE(1,INO)                                                   00755400
      YT=YSCLE(2,INO)                                                   00755500
      IF (YB.NE.0.0) GO TO 5063                                         00755600
      IF (YT.NE.0.0) GO TO 5063                                         00755700
 5055 IF ((YMAX-YMIN).LT.0.1) YMAX=YMAX+0.1                             00755800
      DYT=YMAX-YMIN                                                     00755900
      DY=1.0E-06                                                        00756000
      DO 5060 J=1,8                                                     00756100
      DNB1=(1.5E-05)*10.0**J                                            00756200
      DNB2=(8.0/3.0)*DNB1                                               00756300
      DNB3=2.0*DNB2                                                     00756400
      IF (DYT.GT.DNB1) DY=DNB1/6.0                                      00756500
      IF (DYT.GT.DNB2) DY=DNB2/8.0                                      00756600
      IF (DYT.GT.DNB3) DY=DNB3/8.0                                      00756700
 5060 CONTINUE                                                          00756800
      IF (ICTT.EQ.1.AND.YB.NE.0.0) GO TO 5062                           00756900
      YB=DY*(AINT(YMIN/DY))                                             00757000
      IF (YMIN.LT.0.0) YB=YB-DY                                         00757100
 5062 IF (ICTT.EQ.1.AND.YT.NE.0.0) GO TO 5063                           00757200
      YT=DY*(AINT(YMAX/DY)+1.0)                                         00757300
      IF ((YT-YB).LT.0.1) YT=YT+0.1                                     00757400
 5063 XL=TEMP(1)                                                        00757500
      XR=TEMP(NOPT)                                                     00757600
      CALL SETMIV(24,0,IBB,24)                                          00757700
      CALL DXDYV(1,XL,XR,DXX,MM,II,NXX,10.0,IER)                        00757800
      YT=YTFIX(YT)                                                      00757801
      CALL DXDYV(2,YB,YT,DYY,NN,JJ,NYY,10.0,IER)                        00757900
      CALL GRID1V(-1,XL,XR,YB,YT,DXX,DYY,MM,NN,-II,-JJ,NXX,NYY)         00758000
      IF (IHRS.NE.1) CALL PRINTV(-14,14HTIME - SECONDS,450,IYPP)        00758100
      IF (IHRS.EQ.1) CALL PRINTV(-12,12HTIME - HOURS,450,IYPP)          00758200
      IF (ICRT.LT.0) M=SYMB(TENRY,TDOWN,ICRA)                           00758300
      IF (IN.EQ.1) CALL APRNTV(0,-14,-17,17HHEATING LOAD  BTU,0,590)    00758400
      IF (IN.EQ.2) CALL APRNTV(0,-14,-21,21HHEATING RATE  BTU/SEC,      00758500
     10,650)                                                            00758600
      CALL SCSETV(0,20)                                                 00758700
      IF (ICRA.LT.4) WRITE (16,300) TITLE                               00758800
      IF (ICRA.GE.4.AND.IN.EQ.1) WRITE (16,305)                         00758900
      IF (ICRA.GE.4.AND.IN.EQ.2) WRITE (16,306)                         00759000
      CALL SCSETV(1,24)                                                 00759100
      WRITE (16,FMT4) NCASE,(IDX(J),BCD(J),J=1,IW)                      00759200
      IF (ICRA.GE.4)                                                    00759300
     *CALL RITE2V(IXR,IYR,1023,90,2,13,1,"FIGURE    .  ",IER)           00759400
      IF (ICRA.GE.4)                                                    00759500
     *CALL RITE2V(IXR1,IYR,1023,90,2,60,1,TITLL,IER)                    00759600
      ISM=16                                                            00759700
      KW=0                                                              00759701
      DO 5070 K=1,KEND,NOPT                                             00759800
      KREFO=KREF+K                                                      00759900
      ISM=ISM+1                                                         00760000
      KW=KW+1                                                           00760001
      INM=100+10*(KW-1)                                                 00760002
      DO 5070 J=1,NOPT                                                  00760100
      NX1=NXV(TEMP(J))                                                  00760200
      NY1=NYV(TEMP(KREFO+J))                                            00760300
      IF (J.EQ.1) GO TO 5065                                            00760400
      IF (NX1.LT.INM) GO TO 5064                                        00760500
      INM=INM+100                                                       00760501
      CALL PLOTV(NX1,NY1,ISM)                                           00760502
 5064 CALL LINEV(NX1,NY1,NX2,NY2)                                       00760600
      CALL LINEV(NX1,NY1,NX2,NY2)                                       00760700
 5065 NX2=NX1                                                           00760800
      NY2=NY1                                                           00760900
 5070 CONTINUE                                                          00761000
 5080 CONTINUE                                                          00761100
 5090 CONTINUE                                                          00761200
C                                                                       00761300
C     EXIT                                                              00761400
 9000 READ (10) (TEMP(I),I=1,NWDS)                                      00761500
      RETURN                                                            00761600
      END                                                               00761700
*DECK YTFIX                                                             00761701
      FUNCTION YTFIX(YT)                                                00761702
C                                                                       00761703
 1000 YTF=YT                                                            00761704
      IF (ABS(YT-1000.0).LE.0.001) YTF=1000.0                           00761705
      IF (ABS(YT-100.0).LE.0.001) YTF=100.0                             00761706
      IF (ABS(YT-10.0).LE.0.001) YTF=10.0                               00761707
      IF (ABS(YT-1.0).LE.0.001) YTF=1.0                                 00761708
 1080 YTFIX=YTF                                                         00761709
 1090 RETURN                                                            00761710
      END                                                               00761711
*DECK PNCH                                                              00761712
C     SUBROUTINE PNCH OF PROGRAM XF0031                                 00761800
C     L.W. FESLER     41-383/530  X4263                                 00761900
C                                                                       00762000
C                *****      *****      *****      *****                 00762100
C                                                                       00762200
C     THIS SUBROUTINE PUNCHES CARDS OF TEMPERATURE HISTORY FOR          00762300
C     PROGRAM NARSLAGS.                                                 00762400
C                                                                       00762500
C                *****      *****      *****      *****                 00762600
C                                                                       00762700
      SUBROUTINE PNCH                                                   00762800
C                                                                       00762900
      COMMON /CMN1/ NCASE,INPO(36),INRO(36),DELT,DELTP,TIMEO,TEND,      00763000
     1              FTRN,DMTX,TOLR,RCMIN,DELTC,TIMEC,TIMEP,             00763100
     2              NSCTO,NSCT(300),NOPT,NSPTO,NSPT(300),               00763200
     3              NAOO,NRSOO,NRIOO,NCOO,NCRTOO,                       00763300
     4              FTRT,FTRM,TIME1,TOLRE,TOLR1,TITLE(15),              00763400
     5              ICLOCK,IDOMT,INPP(33)                               00763401
      COMMON /CMN2/ NSCTL(999),TO(300),MTLN(300),DX(300),DY(300),       00763500
     1              DZ(300),NAJ(5,300),IPRNT(300),IDLTO,IDLT(300),      00763600
     2              TN(300),IFTP(300),NOSC(8,300),IOSC(9,300),          00763700
     3              COET(8,300),BCOET(8,300),PCQL(300),IPCT(300),       00763800
     4              ICRDR,ICRDP,CORD(3,300)                             00763900
      COMMON /CMN8/ CAP(300),QTOT(300),TL(300),TL1(300),TL2(300),       00764000
     1              SLPO(300),SLP(300),TPD(300),TCR(300),               00764100
     2              ICAPT,ICOND,IOST,IOSN,ITER,IBDM,IADR,IL             00764200
C                                                                       00764300
      DIMENSION ITN(300),FMT(7)                                         00764400
      EQUIVALENCE (ITN(1),TCR(1)),(FIW,IIW)                             00764500
      DATA INBR / 33333333333333333333B /                               00764600
      DATA FMT / "(A1,","I6, ","    ","I5, ","T73,","A4,4","I1) " /     00764700
C                                                                       00764800
  100 FORMAT(" ",15A4,1X,I5,I4,1X,A4,"0000")                            00764900
  110 FORMAT("-",71X,A4,4I1)                                            00765000
  120 FORMAT("G",1X,I3,1X,3F10.3,36X,A4,4I1)                            00765100
  130 FORMAT("G",1X,I3,1X,3F10.3,2X,I3,1X,3F10.3,A4,4I1)                00765200
  140 FORMAT(A1,I6,T73,A4,4I1)                                          00765201
C                                                                       00765300
C     TITLE CARD                                                        00765400
 1000 REWIND 2                                                          00765500
      REWIND 3                                                          00765600
      IT=2                                                              00765700
      IF (NSPTO.NE.0) IT=3                                              00765800
      NSTTO=NSCTO                                                       00765900
      IF (IT.EQ.3) NSTTO=NSPTO                                          00766000
      CARD=TITLE(15)                                                    00766100
      PUNCH 100,TITLE,NOPT,NSTTO,CARD                                   00766200
      ISEQ=0                                                            00766300
      ICD=NSTTO/14+1                                                    00766400
      ILT=NSTTO+1                                                       00766500
      IF (ICD.GT.1) ILT=ILT-14*(ICD-1)                                  00766600
      DO 1020 I=1,NSTTO                                                 00766800
      ISCT=I                                                            00766900
      ITN(I)=NSCT(I)                                                    00767000
      IF (IT.EQ.2) GO TO 1010                                           00767100
      ITN(I)=NSPT(I)                                                    00767200
      IS=ITN(I)                                                         00767300
      ISCT=NSCTL(IS)                                                    00767400
 1010 IF (ICRDP.EQ.0) GO TO 1020                                        00767500
      SLPO(I)=CORD(1,ISCT)                                              00767501
      SLP(I)=CORD(2,ISCT)                                               00767600
      TPD(I)=CORD(3,ISCT)                                               00767700
 1020 CONTINUE                                                          00767800
      IF (ICRDP.EQ.0) GO TO 1120                                        00767801
      IF (ICDRP.EQ.0) GO TO 1120                                        00767802
      ICC=NSTTO/2                                                       00767900
      IF (NSTTO.GT.(2*ICC)) ICC=ICC+1                                   00768000
      IND=0                                                             00768100
      I1=0                                                              00768200
      DO 1110 IC=1,ICC                                                  00768300
      ISEQ=ISEQ+1                                                       00768400
      I2=ISEQ/100                                                       00768500
      I3=(ISEQ-100*I2)/10                                               00768600
      I4=ISEQ-100*I2-10*I3                                              00768700
      IST=IND+1                                                         00768800
      IND=IST+1                                                         00768900
      IF (IND.GT.NSTTO) IND=NSTTO                                       00769000
      IPT=IND-IST+1                                                     00769100
      IF (IPT.EQ.1) PUNCH 120,(ITN(I),SLPO(I),SLP(I),TPD(I),            00769200
     1I=IST,IND),CARD,I1,I2,I3,I4                                       00769300
      IF (IPT.EQ.2) PUNCH 130,(ITN(I),SLPO(I),SLP(I),TPD(I),            00769400
     1I=IST,IND),CARD,I1,I2,I3,I4                                       00769500
 1110 CONTINUE                                                          00769600
 1120 IND=0                                                             00769601
      IOPT=TEND                                                         00769602
      DO 1140 IC=1,ICD                                                  00769603
      ISEQ=ISEQ+1                                                       00769604
      IF (ISEQ.GT.9999) ISEQ=1                                          00769605
      I1=ISEQ/1000                                                      00769606
      I2=(ISEQ-1000*I1)/100                                             00769607
      I3=(ISEQ-1000*I1-100*I2)/10                                       00769608
      I4=ISEQ-1000*I1-100*I2-10*I3                                      00769609
      IST=IND+1                                                         00769610
      IND=IST+13                                                        00769611
      IF (IC.EQ.1) IND=IND-1                                            00769612
      IF (IND.GT.NSTTO) IND=NSTTO                                       00769613
      IPT=IND-IST                                                       00769614
      IF (IC.EQ.1) IPT=IPT+1                                            00769615
      IF (IPT.EQ.0) GO TO 1130                                          00769616
      IIW=INBR+64*(IPT/10)+IPT-10*(IPT/10)                              00769617
      FMT(3)=FIW                                                        00769618
      IF (IC.EQ.1) PUNCH FMT,CE,IOPT,(ITN(I),I=IST,IND),                00769619
     1CARD,I1,I2,I3,I4                                                  00769620
      IF (IC.GT.1) PUNCH FMT,CE,(ITN(I),I=IST,IND),CARD,I1,I2,I3,I4     00769621
      GO TO 1140                                                        00769622
 1130 PUNCH 140,CE,ITN(NSTTO),CARD,I1,I2,I3,I4                          00769623
 1140 CONTINUE                                                          00769624
C                                                                       00769700
C     SET UP ARRAYS                                                     00769800
 2000 DO 5000 IP=1,NOPT                                                 00769900
      READ (IT) TIMEC,(TPD(I),I=1,NSTTO)                                00770000
      ITIME=TIMEC                                                       00770100
      IF (INPO(34).EQ.1) ITIME=ITIME*3600                               00770200
      DO 2010 I=1,NSTTO                                                 00770300
 2010 ITN(I)=TPD(I)                                                     00770400
C                                                                       00770500
C     PUNCH CARDS                                                       00770600
 3000 IND=0                                                             00770700
      DO 3010 IC=1,ICD                                                  00770800
      ISEQ=ISEQ+1                                                       00770900
      IF (ISEQ.GT.9999) ISEQ=1                                          00771000
      I1=ISEQ/1000                                                      00771100
      I2=(ISEQ-1000*I1)/100                                             00771200
      I3=(ISEQ-1000*I1-100*I2)/10                                       00771300
      I4=ISEQ-1000*I1-100*I2-10*I3                                      00771400
      IST=IND+1                                                         00771500
      IND=IST+13                                                        00771600
      IF (IC.EQ.1) IND=IND-1                                            00771700
      IF (IND.GT.NSTTO) IND=NSTTO                                       00771800
      IPT=IND-IST                                                       00771900
      IF (IC.EQ.1) IPT=IPT+1                                            00772000
      IF (IPT.EQ.0) GO TO 3005                                          00772001
      IIW=INBR+64*(IPT/10)+IPT-10*(IPT/10)                              00772100
      FMT(3)=FIW                                                        00772200
      IF (IC.EQ.1) PUNCH FMT,CT,ITIME,(ITN(I),I=IST,IND),               00772300
     1CARD,I1,I2,I3,I4                                                  00772400
      IF (IC.GT.1) PUNCH FMT,CB,(ITN(I),I=IST,IND),CARD,I1,I2,I3,I4     00772500
      GO TO 3010                                                        00772501
 3005 PUNCH 140,CB,ITN(NSTTO),CARD,I1,I2,I3,I4                          00772502
 3010 CONTINUE                                                          00772600
C                                                                       00772700
 5000 CONTINUE                                                          00772800
C                                                                       00772900
C     END CARD                                                          00773000
 8000 ISEQ=ISEQ+1                                                       00773100
      IF (ISEQ.GT.9999) ISEQ=1                                          00773200
      I1=ISEQ/1000                                                      00773300
      I2=(ISEQ-1000*I1)/100                                             00773400
      I3=(ISEQ-1000*I1-100*I2)/10                                       00773500
      I4=ISEQ-1000*I1-100*I2-10*I3                                      00773600
      PUNCH 110,CARD,I1,I2,I3,I4                                        00773700
C                                                                       00773800
C     EXIT                                                              00773900
 9000 RETURN                                                            00774000
      END                                                               00774100
*DECK TIMEV                                                             00774101
      SUBROUTINE TIMEV(T)                                               00774102
   10 CALL SECOND(T)                                                    00774103
      RETURN                                                            00774104
      END                                                               00774105
*DECK ISIMEQ                                                            00774106
C     SUBPROGRAM TO SOLVE SIMULTANEOUS LINEAR EQUATIONS                 00774107
C       ARGUMENTS-                                                      00774108
C                                                                       00774109
C        DATE- 1/13/67   MODIFIED  FOR COMPILATION IN RELEASE 14        00774110
C                                                                       00774111
C                DSM        DIMENSIONED SIZE OF COEFFICIENT MATRIX      00774112
C                NE         ACTUAL NUMBER OF EQUATIONS FOR THIS CALL    00774113
C                NC         NUMBER OF COLUMNS IN CONSTANT MAT-+X        00774114
C                A          COEFFICIENT MATRIX                          00774115
C                B          CONSTANT MATRIX                             00774116
C                DET        INPUT - SCALE FACTOR, OUTPUT - FACTOR TIMES 00774117
C                           DETERMINANT VALUE OF COEFFICIENT MATRIX     00774118
C                C          TEMPORARY STORAGE FOR SUBROUTINE            00774119
C                ISIMEQ     RETURNS 1 IF OK, 2 IF OVFLO, 3 IF SINGULAR  00774120
C                IF NC IS NEGATIVE, THE INVERSE OF THE COEFFICIENT      00774121
C                MATRIX IS REQUIRED, MATRIX B IS SET UP AS IDENTITY.    00774122
      FUNCTION ISIMEQ( DSM , NE , NC , A , B , DET , C )                00774123
      LOGICAL DVO                                                       00774124
      INTEGER DSM, C, T, SUB1, SUB2,    R, D                            00774125
      DIMENSION  B(1), C(1)                                             00774126
      DIMENSION A(1)                                                    00774127
C     INITIALIZE                                                        00774128
      N          =  NE                                                  00774129
      D = DSM                                                           00774130
      M = IABS(NC)                                                      00774131
      ISIMEQ = 1                                                        00774132
      DVO        =  .FALSE.                                             00774133
      DO 1 I = 1,N                                                      00774134
    1 C(I) = I                                                          00774135
      IF(NC) 5, 15, 15                                                  00774136
C     INVERSE REQUIRED                                                  00774137
    5 SUB2 = 0                                                          00774138
      DO 10 J = 1,N                                                     00774139
        SUB1 = SUB2                                                     00774140
        DO 6 I = 1,N                                                    00774141
        SUB1 = SUB1   1                                                 00774142
    6   B(SUB1) = 0.0                                                   00774143
       SUB1  = SUB2 + J                                                 00774144
       B(SUB1) = 1.0                                                    00774145
   10 SUB2 = SUB2 + D                                                   00774146
C     START MAIN LOOP                                                   00774147
   15 DO 1000 L = 1,N                                                   00774148
         LP1 = L+ 1                                                     00774149
        DO 40 I = L,N                                                   00774150
         PIVOT = 0.0                                                    00774151
          SUB1 = (L-1) * D + I                                          00774152
          SUB2 = SUB1                                                   00774153
            DO 20 J = L,N                                               00774154
             IF(ABS(PIVOT) .GE. ABS(A(SUB1))) GO TO 20                  00774155
             PIVOT = A(SUB1)                                            00774156
             JB = J                                                     00774157
   20       SUB1 = SUB1 + D                                             00774158
C     COMPUTE DETERMINANT                                               00774159
        DET = DET * PIVOT                                               00774160
      IF(.NOT. DVO )  GO TO 24                                          00774161
C     TEST FOR SINGULAR  ATRIX                                          00774162
   24 IF(PIVOT .EQ. 0.0) GO TO 2000                                     00774163
            DO 25 J = L,N                                               00774164
            A(SUB2) = A(SUB2) / PIVOT                                   00774165
   25       SUB2 = SUB2 + D                                             00774166
         IF (DVO) GO TO 35                                              00774167
           SUB1 = I                                                     00774168
            DO 30 J = 1,M                                               00774169
            B(SUB1) = B(SUB1) / PIVOT                                   00774170
   30       SUB1 = SUB1 + D                                             00774171
   35    IF (I .EQ. L) JP = JB                                          00774172
   40   CONTINUE                                                        00774173
C     INTERCHANGE COLUMNS                                               00774174
  100   IF (JP .EQ. L) GO TO 260                                        00774175
      IF (DVO) GO TO 110                                                00774176
        T = C(L)                                                        00774177
        C(L) = C(JP)                                                    00774178
        C(JP) = T                                                       00774179
  110     R = D * L - D                                                 00774180
          T = D * JP - D                                                00774181
          DO 120 I = 1,N                                                00774182
          SUB1 = R + I                                                  00774183
          SUB2 =  T + I                                                 00774184
          S = A(SUB1)                                                   00774185
          A(SUB1) = A(SUB2)                                             00774186
  120     A(SUB2) = S                                                   00774187
        DET = -DET                                                      00774188
C     REDUCE PIVOT COLUMN                                               00774189
  260   R = D* L - D                                                    00774190
        DO 400 I = 1,N                                                  00774191
         IP = R + I                                                     00774192
         PIVOT = A(IP)                                                  00774193
        IF (I .EQ. L .OR. PIVOT .EQ. 0.0) GO TO 400                     00774194
         SUB1 = L                                                       00774195
         SUB2 = I                                                       00774196
          DO 360 J = 1,N                                                00774197
           IF (J .LT. LP1) GO TO 300                                    00774198
            S = PIVOT * A(SUB1)                                         00774199
            A(SUB2) = A(SUB2) - S                                       00774200
           IF (ABS(A(SUB2)) .LT. ABS(2.0E-6 * S)) A(SUB2) = 0.0         00774201
  300     IF (DVO .OR. J .GT. M) GO TO 350                              00774202
            B(SUB2) = B(SUB2) - PIVOT * B(SUB1)                         00774203
  350      SUB1 = SUB1 + D                                              00774204
  360     SUB2 = SUB2 + D                                               00774205
  400   CONTINUE                                                        00774206
 1000 CONTINUE                                                          00774207
      IF (DVO) GO TO 1500                                               00774208
C     REARRANGE VARIABLES                                               00774209
 1100 DO  1201   L=1,N                                                  00774210
       SUB1 = C(L)                                                      00774211
       SUB2 = L                                                         00774212
        DO 1200 J = 1,M                                                 00774213
         A(SUB1) = B(SUB2)                                              00774214
         SUB1 = SUB1 + D                                                00774215
 1200    SUB2 = SUB2 + D                                                00774216
 1201 CONTINUE                                                          00774217
 1500 RETURN                                                            00774218
C     SINGULAR COEFFICIENT MATRIX                                       00774219
 2000 IF(DVO)    GO TO 3000                                             00774220
      ISIMEQ     =  3                                                   00774221
      GO TO 1500                                                        00774222
 3000 IDETRM     =  3                                                   00774223
      GO TO 1500                                                        00774224
      END                                                               00774225
